diff options
| author | Sverker Eriksson <[email protected]> | 2016-02-24 17:55:04 +0100 |
|---|---|---|
| committer | Sverker Eriksson <[email protected]> | 2016-02-24 17:55:04 +0100 |
| commit | 03743cd4193a2ca97f9b9a52a25e63f616e8fc07 (patch) | |
| tree | 9c1f4094a2105ec4bf19dd0d16e76b598d0e608d /lib | |
| parent | 1b094d72ffc56069c72f17c7edd673dbbfe47e39 (diff) | |
| parent | 35739bd06776f90526006486b3f4ab7e54f7f951 (diff) | |
| download | otp-03743cd4193a2ca97f9b9a52a25e63f616e8fc07.tar.gz otp-03743cd4193a2ca97f9b9a52a25e63f616e8fc07.tar.bz2 otp-03743cd4193a2ca97f9b9a52a25e63f616e8fc07.zip | |
Merge branch 'master' into sverk/master/halt-INT_MIN
Diffstat (limited to 'lib')
1092 files changed, 18793 insertions, 31689 deletions
diff --git a/lib/Makefile b/lib/Makefile index 34c2fe9a9e..82c7cb6e18 100644 --- a/lib/Makefile +++ b/lib/Makefile @@ -25,8 +25,7 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk ERTS_APPLICATIONS = stdlib sasl kernel compiler # Then these have to be build -ERLANG_APPLICATIONS = tools test_server common_test runtime_tools \ - inets parsetools +ERLANG_APPLICATIONS = tools common_test runtime_tools inets parsetools # These are only build if -a is given to otp_build or make is used directly ALL_ERLANG_APPLICATIONS = xmerl edoc erl_docgen snmp otp_mibs erl_interface \ @@ -35,8 +34,8 @@ ALL_ERLANG_APPLICATIONS = xmerl edoc erl_docgen snmp otp_mibs erl_interface \ ic mnesia crypto orber os_mon syntax_tools \ public_key ssl observer odbc diameter \ cosTransactions cosEvent cosTime cosNotification \ - cosProperty cosFileTransfer cosEventDomain et megaco webtool \ - eunit ssh typer percept eldap dialyzer hipe ose + cosProperty cosFileTransfer cosEventDomain et megaco \ + eunit ssh typer percept eldap dialyzer hipe ifdef BUILD_ALL ERLANG_APPLICATIONS += $(ALL_ERLANG_APPLICATIONS) diff --git a/lib/asn1/c_src/Makefile b/lib/asn1/c_src/Makefile index 2b72e1a214..e0d4f09a70 100644 --- a/lib/asn1/c_src/Makefile +++ b/lib/asn1/c_src/Makefile @@ -97,12 +97,7 @@ endif _create_dirs := $(shell mkdir -p $(OBJDIR) $(LIBDIR)) -ifneq ($(findstring ose,$(TARGET)),ose) opt: $(NIF_SHARED_OBJ_FILE) -else -# Do not build dynamic files on OSE -opt: -endif debug: opt @@ -140,9 +135,7 @@ include $(ERL_TOP)/make/otp_release_targets.mk release_spec: opt $(INSTALL_DIR) "$(RELSYSDIR)/priv/lib" -ifneq ($(findstring ose,$(TARGET)),ose) $(INSTALL_PROGRAM) $(NIF_SHARED_OBJ_FILE) "$(RELSYSDIR)/priv/lib" -endif $(INSTALL_DIR) "$(RELSYSDIR)/c_src" $(INSTALL_DATA) *.c "$(RELSYSDIR)/c_src" diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 4d17cfb966..f2c895bfaa 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% 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. @@ -1552,9 +1552,11 @@ match_syntax_objset_1(_, {object,_,_}=Object, ClassDef) -> make_objset(ClassDef, Set) -> #typedef{typespec=#'ObjectSet'{class=ClassDef,set=Set}}. +-spec syntax_match_error(_) -> no_return(). syntax_match_error(S) -> asn1_error(S, syntax_nomatch). +-spec syntax_match_error(_, _) -> no_return(). syntax_match_error(S, What0) -> What = printable_string(What0), asn1_error(S, {syntax_nomatch,What}). @@ -5745,6 +5747,7 @@ return_asn1_error(#state{mname=Where}, Item, Error) -> Pos = asn1ct:get_pos_of_def(Item), {structured_error,{Where,Pos},?MODULE,Error}. +-spec asn1_error(_, _) -> no_return(). asn1_error(S, Error) -> throw({error,return_asn1_error(S, Error)}). diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl index 093bcb5a6c..6d5062a118 100644 --- a/lib/asn1/src/asn1ct_gen.erl +++ b/lib/asn1/src/asn1ct_gen.erl @@ -1289,6 +1289,7 @@ gen_head(Erules,Mod,Hrl) -> emit({"-module('",Mod,"').",nl}), put(currmod,Mod), emit({"-compile(nowarn_unused_vars).",nl}), + emit({"-dialyzer(no_improper_lists).",nl}), case Hrl of 0 -> ok; _ -> emit({"-include(\"",Mod,".hrl\").",nl}) diff --git a/lib/asn1/src/asn1ct_imm.erl b/lib/asn1/src/asn1ct_imm.erl index 527f4f0ba9..e09256cde9 100644 --- a/lib/asn1/src/asn1ct_imm.erl +++ b/lib/asn1/src/asn1ct_imm.erl @@ -1120,38 +1120,41 @@ per_enc_constrained(Val0, Lb, Ub, false) -> per_enc_constrained(Val0, Lb, Ub, true) -> {Prefix,Val} = sub_lb(Val0, Lb), Range = Ub - Lb + 1, + Check = {ult,Val,Range}, if Range < 256 -> NumBits = per_num_bits(Range), - Check = {ult,Val,Range}, Put = [{put_bits,Val,NumBits,[1]}], {Prefix,Check,Put}; Range =:= 256 -> NumBits = 8, - Check = {ult,Val,Range}, Put = [{put_bits,Val,NumBits,[1,align]}], {Prefix,Check,Put}; Range =< 65536 -> - Check = {ult,Val,Range}, Put = [{put_bits,Val,16,[1,align]}], {Prefix,Check,Put}; true -> - {var,VarBase} = Val, - Bin = {var,VarBase++"@bin"}, - BinSize0 = {var,VarBase++"@bin_size0"}, - BinSize = {var,VarBase++"@bin_size"}, - Check = {ult,Val,Range}, RangeOctsLen = byte_size(binary:encode_unsigned(Range - 1)), BitsNeeded = per_num_bits(RangeOctsLen), - Enc = [{call,binary,encode_unsigned,[Val],Bin}, - {call,erlang,byte_size,[Bin],BinSize0}, - {sub,BinSize0,1,BinSize}, - {'cond',[['_', - {put_bits,BinSize,BitsNeeded,[1]}, - {put_bits,Bin,binary,[8,align]}]]}], - {Prefix,Check,Enc} + {Prefix,Check,per_enc_constrained_huge(BitsNeeded, Val)} end. +per_enc_constrained_huge(BitsNeeded, {var,VarBase}=Val) -> + Bin = {var,VarBase++"@bin"}, + BinSize0 = {var,VarBase++"@bin_size0"}, + BinSize = {var,VarBase++"@bin_size"}, + [{call,binary,encode_unsigned,[Val],Bin}, + {call,erlang,byte_size,[Bin],BinSize0}, + {sub,BinSize0,1,BinSize}, + {'cond',[['_', + {put_bits,BinSize,BitsNeeded,[1]}, + {put_bits,Bin,binary,[8,align]}]]}]; +per_enc_constrained_huge(BitsNeeded, Val) when is_integer(Val) -> + Bin = binary:encode_unsigned(Val), + BinSize = erlang:byte_size(Bin), + [{put_bits,BinSize-1,BitsNeeded,[1]}, + {put_bits,Val,8*BinSize,[1,align]}]. + per_enc_unconstrained(Val, Aligned) -> case Aligned of false -> []; diff --git a/lib/asn1/src/asn1ct_value.erl b/lib/asn1/src/asn1ct_value.erl index 7f20d57b1e..61a5661a11 100644 --- a/lib/asn1/src/asn1ct_value.erl +++ b/lib/asn1/src/asn1ct_value.erl @@ -353,10 +353,7 @@ random_unnamed_bit_string(M, C) -> %% end. random(Upper) -> - _ = random:seed(erlang:phash2([erlang:node()]), - erlang:monotonic_time(), - erlang:unique_integer()), - random:uniform(Upper). + rand:uniform(Upper). size_random(C) -> case get_constraint(C,'SizeConstraint') of diff --git a/lib/asn1/test/asn1_SUITE.erl b/lib/asn1/test/asn1_SUITE.erl index ce87fd3180..d392055458 100644 --- a/lib/asn1/test/asn1_SUITE.erl +++ b/lib/asn1/test/asn1_SUITE.erl @@ -28,7 +28,7 @@ -compile(export_all). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %%------------------------------------------------------------------------------ %% Suite definition diff --git a/lib/asn1/test/asn1_SUITE_data/Prim.asn1 b/lib/asn1/test/asn1_SUITE_data/Prim.asn1 index b4c011fd39..4fe0901683 100644 --- a/lib/asn1/test/asn1_SUITE_data/Prim.asn1 +++ b/lib/asn1/test/asn1_SUITE_data/Prim.asn1 @@ -60,4 +60,11 @@ BEGIN e BOOLEAN, magic INTEGER } + + Longitude ::= INTEGER { + oneMicrodegreeEast(10), + oneMicrodegreeWest(-10), + unavailable(1800000001) + } (-1799999999..1800000001) + END diff --git a/lib/asn1/test/asn1_SUITE_data/test_records.erl b/lib/asn1/test/asn1_SUITE_data/test_records.erl index adfc98600c..65716bb0dc 100644 --- a/lib/asn1/test/asn1_SUITE_data/test_records.erl +++ b/lib/asn1/test/asn1_SUITE_data/test_records.erl @@ -23,9 +23,6 @@ -export(['check_record_names_OTP-5812'/1]). -%-include("test_server.hrl"). -%-include_lib("test_server/include/test_server.hrl"). - -define(line,put(test_server_loc,{?MODULE,?LINE}),). -include("NBAP-PDU-Discriptions.hrl"). diff --git a/lib/asn1/test/asn1_test_lib.erl b/lib/asn1/test/asn1_test_lib.erl index 4fee5a64cc..dbb2600b41 100644 --- a/lib/asn1/test/asn1_test_lib.erl +++ b/lib/asn1/test/asn1_test_lib.erl @@ -26,7 +26,7 @@ parallel/0, roundtrip/3,roundtrip/4,roundtrip_enc/3,roundtrip_enc/4]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). run_dialyzer() -> false. @@ -58,7 +58,7 @@ dialyze(Files) -> Beams0 = [code:which(module(F)) || F <- Files], Beams = [code:which(asn1rt_nif)|Beams0], case dialyzer:run([{files,Beams}, - {warnings,[no_improper_lists]}, + {warnings,[]}, {get_warnings,true}]) of [] -> ok; diff --git a/lib/asn1/test/error_SUITE.erl b/lib/asn1/test/error_SUITE.erl index a3413d1b3d..caae845592 100644 --- a/lib/asn1/test/error_SUITE.erl +++ b/lib/asn1/test/error_SUITE.erl @@ -27,7 +27,7 @@ object_sets/1,parameterization/1, syntax/1,table_constraints/1,tags/1,values/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks, [ts_install_cth]}]. diff --git a/lib/asn1/test/h323test.erl b/lib/asn1/test/h323test.erl index 39097a9330..566abd9714 100644 --- a/lib/asn1/test/h323test.erl +++ b/lib/asn1/test/h323test.erl @@ -21,7 +21,7 @@ -module(h323test). -export([run/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). run(per) -> run(); run(_Rules) -> ok. diff --git a/lib/asn1/test/syntax_SUITE.erl b/lib/asn1/test/syntax_SUITE.erl index 2c23416433..a354b75062 100644 --- a/lib/asn1/test/syntax_SUITE.erl +++ b/lib/asn1/test/syntax_SUITE.erl @@ -33,7 +33,7 @@ types/1, values/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks, [ts_install_cth]}]. diff --git a/lib/asn1/test/testChoExtension.erl b/lib/asn1/test/testChoExtension.erl index 33515403d1..f4dc00b33c 100644 --- a/lib/asn1/test/testChoExtension.erl +++ b/lib/asn1/test/testChoExtension.erl @@ -22,7 +22,7 @@ -export([extension/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). extension(_Rules) -> diff --git a/lib/asn1/test/testChoExternal.erl b/lib/asn1/test/testChoExternal.erl index 980b837475..fd9bcf4406 100644 --- a/lib/asn1/test/testChoExternal.erl +++ b/lib/asn1/test/testChoExternal.erl @@ -21,7 +21,7 @@ -module(testChoExternal). -export([external/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("External.hrl"). external(_Rules) -> diff --git a/lib/asn1/test/testChoPrim.erl b/lib/asn1/test/testChoPrim.erl index abf3fcdb81..14518285aa 100644 --- a/lib/asn1/test/testChoPrim.erl +++ b/lib/asn1/test/testChoPrim.erl @@ -23,7 +23,7 @@ -export([bool/1]). -export([int/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). bool(Rules) -> roundtrip('ChoCon', {bool0,true}), diff --git a/lib/asn1/test/testChoRecursive.erl b/lib/asn1/test/testChoRecursive.erl index a307d448ed..040aeabe48 100644 --- a/lib/asn1/test/testChoRecursive.erl +++ b/lib/asn1/test/testChoRecursive.erl @@ -23,7 +23,7 @@ -export([recursive/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('ChoRec_something',{a, b, c}). -record('ChoRec2_something',{a, b, c}). diff --git a/lib/asn1/test/testChoTypeRefCho.erl b/lib/asn1/test/testChoTypeRefCho.erl index 378a43fa59..b0a9fd68bd 100644 --- a/lib/asn1/test/testChoTypeRefCho.erl +++ b/lib/asn1/test/testChoTypeRefCho.erl @@ -22,7 +22,7 @@ -export([choice/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). choice(_Rules) -> roundtrip('ChoTRcho', {choCho,{choInt,88}}), diff --git a/lib/asn1/test/testChoTypeRefPrim.erl b/lib/asn1/test/testChoTypeRefPrim.erl index 3541277674..59d23a8683 100644 --- a/lib/asn1/test/testChoTypeRefPrim.erl +++ b/lib/asn1/test/testChoTypeRefPrim.erl @@ -22,7 +22,7 @@ -export([prim/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). prim(_Rules) -> roundtrip('ChoTR', {bool,true}), diff --git a/lib/asn1/test/testChoTypeRefSeq.erl b/lib/asn1/test/testChoTypeRefSeq.erl index c582d6f0fc..87c94fc888 100644 --- a/lib/asn1/test/testChoTypeRefSeq.erl +++ b/lib/asn1/test/testChoTypeRefSeq.erl @@ -22,7 +22,7 @@ -export([seq/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('ChoSeq', {seqInt, seqOs}). -record('ChoSeqImp', {seqInt, seqOs}). diff --git a/lib/asn1/test/testChoTypeRefSet.erl b/lib/asn1/test/testChoTypeRefSet.erl index 2d4f6cce4b..d2ff48af91 100644 --- a/lib/asn1/test/testChoTypeRefSet.erl +++ b/lib/asn1/test/testChoTypeRefSet.erl @@ -22,7 +22,7 @@ -export([set/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('ChoSet', {setInt, setOs}). -record('ChoSetImp', {setInt, setOs}). diff --git a/lib/asn1/test/testChoiceIndefinite.erl b/lib/asn1/test/testChoiceIndefinite.erl index d796871620..f5ae3ff882 100644 --- a/lib/asn1/test/testChoiceIndefinite.erl +++ b/lib/asn1/test/testChoiceIndefinite.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). main(per) -> ok; main(ber) -> diff --git a/lib/asn1/test/testConstraints.erl b/lib/asn1/test/testConstraints.erl index 60b7994929..7da3ea3d38 100644 --- a/lib/asn1/test/testConstraints.erl +++ b/lib/asn1/test/testConstraints.erl @@ -23,7 +23,7 @@ -export([int_constraints/1,refed_NNL_name/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). int_constraints(Rules) -> diff --git a/lib/asn1/test/testContextSwitchingTypes.erl b/lib/asn1/test/testContextSwitchingTypes.erl index f1af6cf0e5..3779f61f2f 100644 --- a/lib/asn1/test/testContextSwitchingTypes.erl +++ b/lib/asn1/test/testContextSwitchingTypes.erl @@ -22,7 +22,7 @@ -export([test/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). test(Config) -> ValT_1 = 'ContextSwitchingTypes':'val1-T'(), diff --git a/lib/asn1/test/testDER.erl b/lib/asn1/test/testDER.erl index 195d8fe5a4..edaaa12eba 100644 --- a/lib/asn1/test/testDER.erl +++ b/lib/asn1/test/testDER.erl @@ -22,7 +22,7 @@ -export([test/0]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). test() -> Val = {'Set',12,{version,214},true}, diff --git a/lib/asn1/test/testDeepTConstr.erl b/lib/asn1/test/testDeepTConstr.erl index 50291bf645..ed37df7204 100644 --- a/lib/asn1/test/testDeepTConstr.erl +++ b/lib/asn1/test/testDeepTConstr.erl @@ -24,7 +24,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). main(_Erule) -> Val1 = {substrings, diff --git a/lib/asn1/test/testDef.erl b/lib/asn1/test/testDef.erl index c07665d097..5fa5711473 100644 --- a/lib/asn1/test/testDef.erl +++ b/lib/asn1/test/testDef.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('Def1',{bool0, bool1 = asn1_DEFAULT, diff --git a/lib/asn1/test/testDoubleEllipses.erl b/lib/asn1/test/testDoubleEllipses.erl index 8dcd979d6a..4a054a14ed 100644 --- a/lib/asn1/test/testDoubleEllipses.erl +++ b/lib/asn1/test/testDoubleEllipses.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('Seq',{a, c}). -record('SeqV1',{a, b}). diff --git a/lib/asn1/test/testEnumExt.erl b/lib/asn1/test/testEnumExt.erl index 122d198205..057fcb694b 100644 --- a/lib/asn1/test/testEnumExt.erl +++ b/lib/asn1/test/testEnumExt.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). main(Rule) when Rule =:= per; Rule =:= uper -> io:format("main(~p)~n",[Rule]), diff --git a/lib/asn1/test/testINSTANCE_OF.erl b/lib/asn1/test/testINSTANCE_OF.erl index afff05a4c5..b9079d8e95 100644 --- a/lib/asn1/test/testINSTANCE_OF.erl +++ b/lib/asn1/test/testINSTANCE_OF.erl @@ -21,7 +21,7 @@ -module(testINSTANCE_OF). -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). main(_Erule) -> Int = roundtrip('Int', 3), diff --git a/lib/asn1/test/testInfObjectClass.erl b/lib/asn1/test/testInfObjectClass.erl index 271be63fc8..a7d0f2b6bd 100644 --- a/lib/asn1/test/testInfObjectClass.erl +++ b/lib/asn1/test/testInfObjectClass.erl @@ -24,7 +24,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). main(Rule) -> %% this test is added for OTP-4591, to test that elements in decoded diff --git a/lib/asn1/test/testMegaco.erl b/lib/asn1/test/testMegaco.erl index b1b1c866be..61794ec02d 100644 --- a/lib/asn1/test/testMegaco.erl +++ b/lib/asn1/test/testMegaco.erl @@ -23,7 +23,7 @@ -export([compile/3,main/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). compile(Config, Erule, Options) -> asn1_test_lib:compile("MEDIA-GATEWAY-CONTROL.asn", Config, [Erule|Options]), diff --git a/lib/asn1/test/testMergeCompile.erl b/lib/asn1/test/testMergeCompile.erl index 6bf7aaa1d6..5011c7d576 100644 --- a/lib/asn1/test/testMergeCompile.erl +++ b/lib/asn1/test/testMergeCompile.erl @@ -23,7 +23,7 @@ -export([main/1,mvrasn/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('InitiatingMessage',{procedureCode,criticality,value}). -record('Iu-ReleaseCommand',{protocolIEs,protocolExtensions}). diff --git a/lib/asn1/test/testNBAPsystem.erl b/lib/asn1/test/testNBAPsystem.erl index e0eeb9fe0c..2a7e39597a 100644 --- a/lib/asn1/test/testNBAPsystem.erl +++ b/lib/asn1/test/testNBAPsystem.erl @@ -22,7 +22,7 @@ -export([compile/2,test/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('InitiatingMessage',{ procedureID, criticality, messageDiscriminator, transactionID, value}). diff --git a/lib/asn1/test/testOpenTypeImplicitTag.erl b/lib/asn1/test/testOpenTypeImplicitTag.erl index 01e0a5e07f..fc2f2a81e6 100644 --- a/lib/asn1/test/testOpenTypeImplicitTag.erl +++ b/lib/asn1/test/testOpenTypeImplicitTag.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). main(_Rules) -> roundtrip('Seq', {'Seq',<<1,1,255>>,<<1,1,255>>,12,<<1,1,255>>}), diff --git a/lib/asn1/test/testOpt.erl b/lib/asn1/test/testOpt.erl index 1f96331966..a15aa28f02 100644 --- a/lib/asn1/test/testOpt.erl +++ b/lib/asn1/test/testOpt.erl @@ -21,7 +21,7 @@ -module(testOpt). -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('Opt1',{bool0, bool1 = asn1_NOVALUE, diff --git a/lib/asn1/test/testParamBasic.erl b/lib/asn1/test/testParamBasic.erl index f4a696ff38..768c5ad2fa 100644 --- a/lib/asn1/test/testParamBasic.erl +++ b/lib/asn1/test/testParamBasic.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('T11',{number, string=asn1_DEFAULT}). -record('T12',{number, string=asn1_DEFAULT}). diff --git a/lib/asn1/test/testParameterizedInfObj.erl b/lib/asn1/test/testParameterizedInfObj.erl index 592dc693f0..8b0353522d 100644 --- a/lib/asn1/test/testParameterizedInfObj.erl +++ b/lib/asn1/test/testParameterizedInfObj.erl @@ -23,7 +23,7 @@ -export([main/2,param/1,ranap/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('AllocationOrRetentionPriority',{priorityLevel,iE_Extensions}). -record('ProtocolExtensionField',{id,criticality,extensionValue}). diff --git a/lib/asn1/test/testPrim.erl b/lib/asn1/test/testPrim.erl index 8fa9973ea5..82da953ca1 100644 --- a/lib/asn1/test/testPrim.erl +++ b/lib/asn1/test/testPrim.erl @@ -28,7 +28,7 @@ -export([null/1]). -export([real/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). bool(Rules) -> Types = ['Bool','BoolCon','BoolPri','BoolApp', @@ -78,8 +78,37 @@ int(Rules) -> roundtrip('ASeq', {'ASeq',false,250,true,200,true,199,true,77788}), roundtrip('ASeq', {'ASeq',true,0,false,0,true,0,true,68789}), + %%========================================================== + %% Longitude ::= INTEGER { + %% oneMicrodegreeEast(10), + %% oneMicrodegreeWest(-10), + %% unavailable(1800000001) + %% } (-1799999999..1800000001) + %%========================================================== + + Enc10 = encoding(Rules, oneMicrodegreeEast), + Enc10 = roundtrip('Longitude', oneMicrodegreeEast), + Enc10 = roundtrip('Longitude', 10, oneMicrodegreeEast), + + Enc20 = encoding(Rules, oneMicrodegreeWest), + Enc20 = roundtrip('Longitude', oneMicrodegreeWest), + Enc20 = roundtrip('Longitude', -10, oneMicrodegreeWest), + + Enc30 = roundtrip('Longitude', unavailable), + Enc30 = roundtrip('Longitude', 1800000001, unavailable), + ok. +encoding(Rules, Type) -> + asn1_test_lib:hex_to_bin(encoding_1(Rules, Type)). + +encoding_1(ber, oneMicrodegreeEast) -> "02010A"; +encoding_1(per, oneMicrodegreeEast) -> "C06B49D2 09"; +encoding_1(uper, oneMicrodegreeEast) -> "6B49D209"; + +encoding_1(ber, oneMicrodegreeWest) -> "0201F6"; +encoding_1(per, oneMicrodegreeWest) -> "C06B49D1 F5"; +encoding_1(uper, oneMicrodegreeWest) -> "6B49D1F5". enum(Rules) -> diff --git a/lib/asn1/test/testPrimExternal.erl b/lib/asn1/test/testPrimExternal.erl index 56252241d4..79c8a3a045 100644 --- a/lib/asn1/test/testPrimExternal.erl +++ b/lib/asn1/test/testPrimExternal.erl @@ -22,7 +22,7 @@ -export([external/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). external(_Rules) -> Types = ['NT', diff --git a/lib/asn1/test/testPrimStrings.erl b/lib/asn1/test/testPrimStrings.erl index 46793c6bff..042b1757ba 100644 --- a/lib/asn1/test/testPrimStrings.erl +++ b/lib/asn1/test/testPrimStrings.erl @@ -33,7 +33,7 @@ -export([utf8_string/1]). -export([fragmented/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). fragmented(Rules) -> Lens = fragmented_lengths(), @@ -54,7 +54,7 @@ fragmented_strings(Len, Types) -> ok. make_ns_value(0) -> []; -make_ns_value(N) -> [($0 - 1) + random:uniform(10)|make_ns_value(N-1)]. +make_ns_value(N) -> [($0 - 1) + rand:uniform(10)|make_ns_value(N-1)]. fragmented_lengths() -> K16 = 1 bsl 14, diff --git a/lib/asn1/test/testRfcs.erl b/lib/asn1/test/testRfcs.erl index 20eaee9982..fa4389b904 100644 --- a/lib/asn1/test/testRfcs.erl +++ b/lib/asn1/test/testRfcs.erl @@ -23,7 +23,7 @@ -export([compile/3,test/0]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). compile(Config, Erules, Options0) -> Options = [no_ok_wrapper|Options0], diff --git a/lib/asn1/test/testSSLspecs.erl b/lib/asn1/test/testSSLspecs.erl index 9e51021ad2..7dc7eedd50 100644 --- a/lib/asn1/test/testSSLspecs.erl +++ b/lib/asn1/test/testSSLspecs.erl @@ -23,7 +23,7 @@ -export([compile/2,run/1,compile_combined/2,run_combined/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). compile(Config, Options) -> DataDir = ?config(data_dir, Config), diff --git a/lib/asn1/test/testSelectionTypes.erl b/lib/asn1/test/testSelectionTypes.erl index d33cfcc694..7039f6da4e 100644 --- a/lib/asn1/test/testSelectionTypes.erl +++ b/lib/asn1/test/testSelectionTypes.erl @@ -21,7 +21,7 @@ -module(testSelectionTypes). -export([test/0]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). test() -> ["Es"] = Val2 = ['SelectionType':einsteinium()], diff --git a/lib/asn1/test/testSeq2738.erl b/lib/asn1/test/testSeq2738.erl index 3c9e4a744e..a75d058259 100644 --- a/lib/asn1/test/testSeq2738.erl +++ b/lib/asn1/test/testSeq2738.erl @@ -21,7 +21,7 @@ -module(testSeq2738). -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('SeqOptFake',{int, opt = asn1_NOVALUE}). -record('OptSeqFake',{bool = false}). diff --git a/lib/asn1/test/testSeqDefault.erl b/lib/asn1/test/testSeqDefault.erl index db0914bf0a..ac3cf202b7 100644 --- a/lib/asn1/test/testSeqDefault.erl +++ b/lib/asn1/test/testSeqDefault.erl @@ -23,7 +23,7 @@ -include("External.hrl"). -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('SeqDef1',{bool1 = asn1_DEFAULT, int1, seq1 = asn1_DEFAULT}). -record('SeqDef1Imp',{bool1 = asn1_DEFAULT, int1, seq1 = asn1_DEFAULT}). diff --git a/lib/asn1/test/testSeqExtension.erl b/lib/asn1/test/testSeqExtension.erl index 6b49b29047..a84b6fb27c 100644 --- a/lib/asn1/test/testSeqExtension.erl +++ b/lib/asn1/test/testSeqExtension.erl @@ -23,7 +23,7 @@ -include("External.hrl"). -export([main/3]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('SeqExt1',{}). -record('SeqExt2',{bool, int}). diff --git a/lib/asn1/test/testSeqExternal.erl b/lib/asn1/test/testSeqExternal.erl index a48794924f..9ad2c03208 100644 --- a/lib/asn1/test/testSeqExternal.erl +++ b/lib/asn1/test/testSeqExternal.erl @@ -23,7 +23,7 @@ -include("External.hrl"). -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('SeqXSet1',{set, bool, int}). -record('SeqXSet2',{bool, set, int}). diff --git a/lib/asn1/test/testSeqOf.erl b/lib/asn1/test/testSeqOf.erl index 898b8c1e15..f4a4181f51 100644 --- a/lib/asn1/test/testSeqOf.erl +++ b/lib/asn1/test/testSeqOf.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('Seq1',{bool1, int1, seq1 = asn1_DEFAULT}). -record('Seq2',{seq2 = asn1_DEFAULT, bool2, int2}). diff --git a/lib/asn1/test/testSeqOfCho.erl b/lib/asn1/test/testSeqOfCho.erl index 82ac56ac50..7bd1ce7aa6 100644 --- a/lib/asn1/test/testSeqOfCho.erl +++ b/lib/asn1/test/testSeqOfCho.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('SeqChoDef',{bool1, int1, seq1 = asn1_DEFAULT}). -record('SeqChoOpt',{bool1, int1, seq1 = asn1_NOVALUE}). diff --git a/lib/asn1/test/testSeqOfExternal.erl b/lib/asn1/test/testSeqOfExternal.erl index 560fdecb64..de95e081d5 100644 --- a/lib/asn1/test/testSeqOfExternal.erl +++ b/lib/asn1/test/testSeqOfExternal.erl @@ -21,7 +21,7 @@ -module(testSeqOfExternal). -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("External.hrl"). -record('NT',{os, bool}). diff --git a/lib/asn1/test/testSeqOfIndefinite.erl b/lib/asn1/test/testSeqOfIndefinite.erl index 4a0101834a..bebd516c5c 100644 --- a/lib/asn1/test/testSeqOfIndefinite.erl +++ b/lib/asn1/test/testSeqOfIndefinite.erl @@ -22,7 +22,7 @@ -export([main/0]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). main() -> ?line ok = test(isd), diff --git a/lib/asn1/test/testSeqOfTag.erl b/lib/asn1/test/testSeqOfTag.erl index 55f807199f..cacbc85093 100644 --- a/lib/asn1/test/testSeqOfTag.erl +++ b/lib/asn1/test/testSeqOfTag.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("External.hrl"). diff --git a/lib/asn1/test/testSeqOptional.erl b/lib/asn1/test/testSeqOptional.erl index db615d6e4d..92b49e9c0d 100644 --- a/lib/asn1/test/testSeqOptional.erl +++ b/lib/asn1/test/testSeqOptional.erl @@ -23,7 +23,7 @@ -include("External.hrl"). -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('SeqOpt1',{bool1 = asn1_NOVALUE, int1, seq1 = asn1_NOVALUE}). -record('SeqOpt1Imp',{bool1 = asn1_NOVALUE, int1, seq1 = asn1_NOVALUE}). diff --git a/lib/asn1/test/testSeqPrim.erl b/lib/asn1/test/testSeqPrim.erl index 6af0ce9287..5872902ce7 100644 --- a/lib/asn1/test/testSeqPrim.erl +++ b/lib/asn1/test/testSeqPrim.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('Seq',{bool, boolCon, boolPri, boolApp, boolExpCon, boolExpPri, boolExpApp}). -record('Empty',{}). diff --git a/lib/asn1/test/testSeqSetDefaultVal.erl b/lib/asn1/test/testSeqSetDefaultVal.erl index 86ab07a4a8..1c41f64078 100644 --- a/lib/asn1/test/testSeqSetDefaultVal.erl +++ b/lib/asn1/test/testSeqSetDefaultVal.erl @@ -22,7 +22,7 @@ -export([main/2]). -include("External.hrl"). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('SeqInts',{a = asn1_DEFAULT, b = asn1_DEFAULT, diff --git a/lib/asn1/test/testSeqSetIndefinite.erl b/lib/asn1/test/testSeqSetIndefinite.erl index 8948e10ece..41e09f7796 100644 --- a/lib/asn1/test/testSeqSetIndefinite.erl +++ b/lib/asn1/test/testSeqSetIndefinite.erl @@ -21,7 +21,7 @@ -module(testSeqSetIndefinite). -export([main/0]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). main() -> seq_indefinite(), diff --git a/lib/asn1/test/testSeqTag.erl b/lib/asn1/test/testSeqTag.erl index baa79ed428..6959e2f7e2 100644 --- a/lib/asn1/test/testSeqTag.erl +++ b/lib/asn1/test/testSeqTag.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("External.hrl"). -record('SeqTag',{nt, imp, exp}). diff --git a/lib/asn1/test/testSeqTypeRefCho.erl b/lib/asn1/test/testSeqTypeRefCho.erl index 372be0c637..4a9ba53291 100644 --- a/lib/asn1/test/testSeqTypeRefCho.erl +++ b/lib/asn1/test/testSeqTypeRefCho.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("External.hrl"). -record('SeqTRcho',{seqCho, seqChoE, 'seqCho-E', 'seqChoE-E'}). diff --git a/lib/asn1/test/testSeqTypeRefPrim.erl b/lib/asn1/test/testSeqTypeRefPrim.erl index 42554e758e..e0c3277156 100644 --- a/lib/asn1/test/testSeqTypeRefPrim.erl +++ b/lib/asn1/test/testSeqTypeRefPrim.erl @@ -21,7 +21,7 @@ -module(testSeqTypeRefPrim). -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('SeqTR',{octStr, octStrI, octStrE, 'octStr-I', 'octStrI-I', 'octStrE-I', 'octStr-E', 'octStrI-E', 'octStrE-E'}). diff --git a/lib/asn1/test/testSeqTypeRefSeq.erl b/lib/asn1/test/testSeqTypeRefSeq.erl index ee30937af5..befbe5f457 100644 --- a/lib/asn1/test/testSeqTypeRefSeq.erl +++ b/lib/asn1/test/testSeqTypeRefSeq.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('Seq1',{bool1, int1, seq1}). -record('Seq2',{seq2, bool2, int2}). diff --git a/lib/asn1/test/testSeqTypeRefSet.erl b/lib/asn1/test/testSeqTypeRefSet.erl index ba690b4503..48c94a8b06 100644 --- a/lib/asn1/test/testSeqTypeRefSet.erl +++ b/lib/asn1/test/testSeqTypeRefSet.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('SeqTRset',{seqSet, seqSetI, seqSetE, 'seqSet-I', 'seqSetI-I', 'seqSetE-I', 'seqSet-E', 'seqSetI-E', 'seqSetE-E'}). -record('SeqSet',{setInt, setOs}). diff --git a/lib/asn1/test/testSetDefault.erl b/lib/asn1/test/testSetDefault.erl index 4e34c01a52..e91a526add 100644 --- a/lib/asn1/test/testSetDefault.erl +++ b/lib/asn1/test/testSetDefault.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('SetDef1',{bool1 = asn1_DEFAULT, int1, set1 = asn1_DEFAULT}). -record('SetDef2',{set2 = asn1_DEFAULT, bool2, int2}). diff --git a/lib/asn1/test/testSetExtension.erl b/lib/asn1/test/testSetExtension.erl index 67977a2a31..89f27a7fef 100644 --- a/lib/asn1/test/testSetExtension.erl +++ b/lib/asn1/test/testSetExtension.erl @@ -22,7 +22,7 @@ -include("External.hrl"). -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('SetExt1',{}). -record('SetExt2',{bool, int}). diff --git a/lib/asn1/test/testSetExternal.erl b/lib/asn1/test/testSetExternal.erl index e265cf1f3e..f5d01e23a8 100644 --- a/lib/asn1/test/testSetExternal.erl +++ b/lib/asn1/test/testSetExternal.erl @@ -22,7 +22,7 @@ -export([main/1]). -include("External.hrl"). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('SetXSeq1',{seq, bool, int}). -record('SetXSeq2',{bool, seq, int}). diff --git a/lib/asn1/test/testSetOf.erl b/lib/asn1/test/testSetOf.erl index 4ff90676aa..02009dc8d5 100644 --- a/lib/asn1/test/testSetOf.erl +++ b/lib/asn1/test/testSetOf.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('Set1',{bool1, int1, set1 = asn1_DEFAULT}). -record('Set2',{set2 = asn1_DEFAULT, bool2, int2}). diff --git a/lib/asn1/test/testSetOfCho.erl b/lib/asn1/test/testSetOfCho.erl index 002fa9be0a..be199b4688 100644 --- a/lib/asn1/test/testSetOfCho.erl +++ b/lib/asn1/test/testSetOfCho.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('SetChoDef',{bool1, int1, set1 = asn1_DEFAULT}). -record('SetChoOpt',{bool1, int1, set1 = asn1_NOVALUE}). diff --git a/lib/asn1/test/testSetOfExternal.erl b/lib/asn1/test/testSetOfExternal.erl index 60bde33962..7abed66167 100644 --- a/lib/asn1/test/testSetOfExternal.erl +++ b/lib/asn1/test/testSetOfExternal.erl @@ -21,7 +21,7 @@ -module(testSetOfExternal). -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("External.hrl"). -record('NT',{os, bool}). diff --git a/lib/asn1/test/testSetOfTag.erl b/lib/asn1/test/testSetOfTag.erl index 96dc9942d7..ce77e2848f 100644 --- a/lib/asn1/test/testSetOfTag.erl +++ b/lib/asn1/test/testSetOfTag.erl @@ -21,7 +21,7 @@ -module(testSetOfTag). -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("External.hrl"). -record('SetTagNt',{nt}). diff --git a/lib/asn1/test/testSetPrim.erl b/lib/asn1/test/testSetPrim.erl index a4b8bb2f09..47913178f3 100644 --- a/lib/asn1/test/testSetPrim.erl +++ b/lib/asn1/test/testSetPrim.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('Set',{bool, boolCon, boolPri, boolApp, boolExpCon, boolExpPri, boolExpApp}). -record('Empty',{}). diff --git a/lib/asn1/test/testSetTag.erl b/lib/asn1/test/testSetTag.erl index b963ecb4b3..2e95fb6793 100644 --- a/lib/asn1/test/testSetTag.erl +++ b/lib/asn1/test/testSetTag.erl @@ -21,7 +21,7 @@ -module(testSetTag). -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("External.hrl"). -record('SetTag',{nt, imp, exp}). diff --git a/lib/asn1/test/testSetTypeRefCho.erl b/lib/asn1/test/testSetTypeRefCho.erl index adffb646fb..ac5bf5ab02 100644 --- a/lib/asn1/test/testSetTypeRefCho.erl +++ b/lib/asn1/test/testSetTypeRefCho.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("External.hrl"). -record('SetTRcho',{setCho, setChoE, 'setCho-E', 'setChoE-E'}). diff --git a/lib/asn1/test/testSetTypeRefPrim.erl b/lib/asn1/test/testSetTypeRefPrim.erl index e20b6c57ab..51190e2ba4 100644 --- a/lib/asn1/test/testSetTypeRefPrim.erl +++ b/lib/asn1/test/testSetTypeRefPrim.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('SetTR',{octStr, octStrI, octStrE, 'octStr-I', 'octStrI-I', 'octStrE-I', 'octStr-E', 'octStrI-E', 'octStrE-E'}). diff --git a/lib/asn1/test/testSetTypeRefSeq.erl b/lib/asn1/test/testSetTypeRefSeq.erl index 0d2bd6b32d..44a7910526 100644 --- a/lib/asn1/test/testSetTypeRefSeq.erl +++ b/lib/asn1/test/testSetTypeRefSeq.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('SetTRseq',{setSeq, setSeqI, setSeqE, 'setSeq-I', 'setSeqI-I', 'setSeqE-I', 'setSeq-E', 'setSeqI-E', 'setSeqE-E'}). -record('SetSeq',{seqInt, seqOs}). diff --git a/lib/asn1/test/testSetTypeRefSet.erl b/lib/asn1/test/testSetTypeRefSet.erl index 85d9bf52cd..7a67e6434c 100644 --- a/lib/asn1/test/testSetTypeRefSet.erl +++ b/lib/asn1/test/testSetTypeRefSet.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('Set1',{bool1, int1, set1}). -record('Set2',{set2, bool2, int2}). diff --git a/lib/asn1/test/testTCAP.erl b/lib/asn1/test/testTCAP.erl index 6c66d73feb..6e777875f6 100644 --- a/lib/asn1/test/testTCAP.erl +++ b/lib/asn1/test/testTCAP.erl @@ -22,7 +22,7 @@ -export([compile/2,test/2,compile_asn1config/2,test_asn1config/0]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). compile(Config, Options) -> Files = ["Remote-Operations-Information-Objects", diff --git a/lib/asn1/test/testTimer.erl b/lib/asn1/test/testTimer.erl index 30e31796e2..6fecee3d78 100644 --- a/lib/asn1/test/testTimer.erl +++ b/lib/asn1/test/testTimer.erl @@ -21,7 +21,7 @@ -module(testTimer). -export([go/0]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(times, 5000). diff --git a/lib/asn1/test/test_compile_options.erl b/lib/asn1/test/test_compile_options.erl index 8be3a29763..1af614f49a 100644 --- a/lib/asn1/test/test_compile_options.erl +++ b/lib/asn1/test/test_compile_options.erl @@ -21,7 +21,7 @@ -module(test_compile_options). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([wrong_path/1,comp/2,path/1,ticket_6143/1,noobj/1, diff --git a/lib/asn1/test/test_modified_x420.erl b/lib/asn1/test/test_modified_x420.erl index f9a29d1436..c0a32e2a37 100644 --- a/lib/asn1/test/test_modified_x420.erl +++ b/lib/asn1/test/test_modified_x420.erl @@ -21,7 +21,7 @@ -module(test_modified_x420). -export([test/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). test(Config) -> DataDir = ?config(data_dir,Config), diff --git a/lib/asn1/test/test_partial_incomplete_decode.erl b/lib/asn1/test/test_partial_incomplete_decode.erl index d5eacc5a4d..64f2ce22ae 100644 --- a/lib/asn1/test/test_partial_incomplete_decode.erl +++ b/lib/asn1/test/test_partial_incomplete_decode.erl @@ -22,7 +22,7 @@ -export([test/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). test(Config) -> FMsg = msg('F'), diff --git a/lib/asn1/test/test_selective_decode.erl b/lib/asn1/test/test_selective_decode.erl index 079351db19..d7870057a8 100644 --- a/lib/asn1/test/test_selective_decode.erl +++ b/lib/asn1/test/test_selective_decode.erl @@ -21,7 +21,7 @@ -module(test_selective_decode). -export([test/0]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). test() -> FMsg = msg('F'), diff --git a/lib/asn1/test/test_special_decode_performance.erl b/lib/asn1/test/test_special_decode_performance.erl index 7bb324c902..6cf7ee2805 100644 --- a/lib/asn1/test/test_special_decode_performance.erl +++ b/lib/asn1/test/test_special_decode_performance.erl @@ -22,7 +22,7 @@ -export([go/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). go(all) -> {Time_S_s,Time_S_e,Time_S_c}=go(10000,'PartialDecSeq'), diff --git a/lib/asn1/test/test_undecoded_rest.erl b/lib/asn1/test/test_undecoded_rest.erl index 6264530fff..77147d59cc 100644 --- a/lib/asn1/test/test_undecoded_rest.erl +++ b/lib/asn1/test/test_undecoded_rest.erl @@ -22,7 +22,7 @@ -export([test/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% testing OTP-5104 diff --git a/lib/asn1/test/test_x691.erl b/lib/asn1/test/test_x691.erl index 56c1b9bf71..8ef62960ff 100644 --- a/lib/asn1/test/test_x691.erl +++ b/lib/asn1/test/test_x691.erl @@ -21,7 +21,7 @@ -module(test_x691). -export([cases/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). cases(Erule) -> _ = [begin diff --git a/lib/common_test/doc/src/notes.xml b/lib/common_test/doc/src/notes.xml index 9906db2c90..57a8c6c9e2 100644 --- a/lib/common_test/doc/src/notes.xml +++ b/lib/common_test/doc/src/notes.xml @@ -33,6 +33,26 @@ <file>notes.xml</file> </header> +<section><title>Common_Test 1.11.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + If a ssh package contained more than one netconf end tag, + then the second end tag was never detected in + ct_netconfc:handle_data. Instead it was included in the + XML data given to the xmerl parser, which then failed. + The problem was introduced by OTP-13007, and has now been + corrected.</p> + <p> + Own Id: OTP-13323</p> + </item> + </list> + </section> + +</section> + <section><title>Common_Test 1.11.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/common_test/include/ct.hrl b/lib/common_test/include/ct.hrl index 53bc43fc24..5806f75806 100644 --- a/lib/common_test/include/ct.hrl +++ b/lib/common_test/include/ct.hrl @@ -18,8 +18,6 @@ %% %CopyrightEnd% %% --include_lib("test_server/include/test_server.hrl"). - %% the log level is used as argument to any CT logging function -define(MIN_IMPORTANCE, 0 ). -define(LOW_IMPORTANCE, 25). @@ -37,3 +35,9 @@ %% name of process executing the CT Hook init and terminate function -define(CT_HOOK_INIT_PROCESS, ct_util_server). -define(CT_HOOK_TERMINATE_PROCESS, ct_util_server). + +%% Backward compatibility for test_server test suites. +%% DO NOT USE IN NEW TEST SUITES. +-define(line,). +-define(t,test_server). +-define(config,test_server:lookup_config). diff --git a/lib/common_test/src/Makefile b/lib/common_test/src/Makefile index 987345c679..91c1e8ede8 100644 --- a/lib/common_test/src/Makefile +++ b/lib/common_test/src/Makefile @@ -79,7 +79,15 @@ MODULES= \ cth_conn_log \ ct_groups \ ct_property_test \ - ct_release_test + ct_release_test \ + erl2html2 \ + test_server_ctrl \ + test_server_gl \ + test_server_io \ + test_server_node \ + test_server \ + test_server_sup + TARGET_MODULES= $(MODULES:%=$(EBIN)/%) BEAM_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) @@ -101,8 +109,7 @@ DTD_FILES = \ # FLAGS # ---------------------------------------------------- ERL_COMPILE_FLAGS += -pa ../ebin -I../include -I $(ERL_TOP)/lib/snmp/include/ \ - -I../../test_server/include -I../../xmerl/inc/ \ - -I $(ERL_TOP)/lib/kernel/include -Werror + -I../../xmerl/inc/ -I $(ERL_TOP)/lib/kernel/include -Werror # ---------------------------------------------------- # Targets diff --git a/lib/common_test/src/ct_config.erl b/lib/common_test/src/ct_config.erl index 251204aa75..33efe7a14a 100644 --- a/lib/common_test/src/ct_config.erl +++ b/lib/common_test/src/ct_config.erl @@ -694,11 +694,10 @@ make_crypto_key(String) -> {[K1,K2,K3],IVec}. random_bytes(N) -> - random:seed(os:timestamp()), random_bytes_1(N, []). random_bytes_1(0, Acc) -> Acc; -random_bytes_1(N, Acc) -> random_bytes_1(N-1, [random:uniform(255)|Acc]). +random_bytes_1(N, Acc) -> random_bytes_1(N-1, [rand:uniform(255)|Acc]). check_callback_load(Callback) -> case code:is_loaded(Callback) of diff --git a/lib/common_test/src/ct_make.erl b/lib/common_test/src/ct_make.erl index f4b81a0ef6..e7a9cfa843 100644 --- a/lib/common_test/src/ct_make.erl +++ b/lib/common_test/src/ct_make.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2013. All Rights Reserved. +%% Copyright Ericsson AB 2009-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. @@ -324,10 +324,11 @@ check_includes(File, IncludePath, ObjMTime) -> end. check_includes2(Epp, File, ObjMTime) -> + A1 = erl_anno:new(1), case epp:parse_erl_form(Epp) of - {ok, {attribute, 1, file, {File, 1}}} -> + {ok, {attribute, A1, file, {File, A1}}} -> check_includes2(Epp, File, ObjMTime); - {ok, {attribute, 1, file, {IncFile, 1}}} -> + {ok, {attribute, A1, file, {IncFile, A1}}} -> case file:read_file_info(IncFile) of {ok, #file_info{mtime=MTime}} when MTime>ObjMTime -> epp:close(Epp), diff --git a/lib/common_test/src/ct_netconfc.erl b/lib/common_test/src/ct_netconfc.erl index 6e3d1ab1d8..3da1115c76 100644 --- a/lib/common_test/src/ct_netconfc.erl +++ b/lib/common_test/src/ct_netconfc.erl @@ -264,6 +264,7 @@ session_id, msg_id = 1, hello_status, + no_end_tag_buff = <<>>, buff = <<>>, pending = [], % [#pending] event_receiver}).% pid @@ -1170,7 +1171,7 @@ handle_msg({Ref,timeout},#state{pending=Pending} = State) -> end, %% Halfhearted try to get in correct state, this matches %% the implementation before this patch - {R,State#state{pending=Pending1, buff= <<>>}}. + {R,State#state{pending=Pending1, no_end_tag_buff= <<>>, buff= <<>>}}. %% @private %% Called by ct_util_server to close registered connections before terminate. @@ -1205,7 +1206,7 @@ call(Client, Msg, Timeout, WaitStop) -> {error,no_such_client}; {error,{process_down,Pid,normal}} when WaitStop -> %% This will happen when server closes connection - %% before clien received rpc-reply on + %% before client received rpc-reply on %% close-session. ok; {error,{process_down,Pid,normal}} -> @@ -1372,24 +1373,37 @@ to_xml_doc(Simple) -> %%%----------------------------------------------------------------- %%% Parse and handle received XML data -handle_data(NewData,#state{connection=Connection,buff=Buff0} = State0) -> +%%% Two buffers are used: +%%% * 'no_end_tag_buff' contains data that is checked and does not +%%% contain any (part of an) end tag. +%%% * 'buff' contains all other saved data - it may or may not +%%% include (a part of) an end tag. +%%% The reason for this is to avoid running binary:split/3 multiple +%%% times on the same data when it does not contain an end tag. This +%%% can be a considerable optimation in the case when a lot of data is +%%% received (e.g. when fetching all data from a node) and the data is +%%% sent in multiple ssh packages. +handle_data(NewData,#state{connection=Connection} = State0) -> log(Connection,recv,NewData), - {Start,AddSz} = - case byte_size(Buff0) of - BSz when BSz<5 -> {0,BSz}; - BSz -> {BSz-5,5} - end, - Length = byte_size(NewData) + AddSz, + NoEndTag0 = State0#state.no_end_tag_buff, + Buff0 = State0#state.buff, Data = <<Buff0/binary, NewData/binary>>, - case binary:split(Data,?END_TAG,[{scope,{Start,Length}}]) of + case binary:split(Data,?END_TAG,[]) of [_NoEndTagFound] -> - {noreply, State0#state{buff=Data}}; + NoEndTagSize = case byte_size(Data) of + Sz when Sz<5 -> 0; + Sz -> Sz-5 + end, + <<NoEndTag1:NoEndTagSize/binary,Buff/binary>> = Data, + NoEndTag = <<NoEndTag0/binary,NoEndTag1/binary>>, + {noreply, State0#state{no_end_tag_buff=NoEndTag, buff=Buff}}; [FirstMsg0,Buff1] -> - FirstMsg = remove_initial_nl(FirstMsg0), + FirstMsg = remove_initial_nl(<<NoEndTag0/binary,FirstMsg0/binary>>), SaxArgs = [{event_fun,fun sax_event/3}, {event_state,[]}], case xmerl_sax_parser:stream(FirstMsg, SaxArgs) of {ok, Simple, _Thrash} -> - case decode(Simple, State0#state{buff=Buff1}) of + case decode(Simple, State0#state{no_end_tag_buff= <<>>, + buff=Buff1}) of {noreply, #state{buff=Buff} = State} when Buff =/= <<>> -> %% Recurse if we have more data in buffer handle_data(<<>>, State); @@ -1401,10 +1415,12 @@ handle_data(NewData,#state{connection=Connection,buff=Buff0} = State0) -> [{parse_error,Reason}, {buffer, Buff0}, {new_data,NewData}]), - handle_error(Reason, State0#state{buff= <<>>}) + handle_error(Reason, State0#state{no_end_tag_buff= <<>>, + buff= <<>>}) end end. + %% xml does not accept a leading nl and some netconf server add a nl after %% each ?END_TAG, ignore them remove_initial_nl(<<"\n", Data/binary>>) -> diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl index 0b646ffd07..39b2c2a8cd 100644 --- a/lib/common_test/src/ct_run.erl +++ b/lib/common_test/src/ct_run.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2014. All Rights Reserved. +%% Copyright Ericsson AB 2004-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. @@ -909,7 +909,7 @@ run_test(StartOpt) when is_tuple(StartOpt) -> run_test([StartOpt]); run_test(StartOpts) when is_list(StartOpts) -> - CTPid = spawn(fun() -> run_test1(StartOpts) end), + CTPid = spawn(run_test1_fun(StartOpts)), Ref = monitor(process, CTPid), receive {'DOWN',Ref,process,CTPid,{user_error,Error}} -> @@ -918,6 +918,11 @@ run_test(StartOpts) when is_list(StartOpts) -> Other end. +-spec run_test1_fun(_) -> fun(() -> no_return()). + +run_test1_fun(StartOpts) -> + fun() -> run_test1(StartOpts) end. + run_test1(StartOpts) when is_list(StartOpts) -> case proplists:get_value(refresh_logs, StartOpts) of undefined -> @@ -1369,7 +1374,7 @@ run_dir(Opts = #opts{logdir = LogDir, %%% @equiv ct:run_testspec/1 %%%----------------------------------------------------------------- run_testspec(TestSpec) -> - CTPid = spawn(fun() -> run_testspec1(TestSpec) end), + CTPid = spawn(run_testspec1_fun(TestSpec)), Ref = monitor(process, CTPid), receive {'DOWN',Ref,process,CTPid,{user_error,Error}} -> @@ -1378,6 +1383,11 @@ run_testspec(TestSpec) -> Other end. +-spec run_testspec1_fun(_) -> fun(() -> no_return()). + +run_testspec1_fun(TestSpec) -> + fun() -> run_testspec1(TestSpec) end. + run_testspec1(TestSpec) -> {ok,Cwd} = file:get_cwd(), io:format("~nCommon Test starting (cwd is ~ts)~n~n", [Cwd]), @@ -2617,11 +2627,9 @@ run_make(Targets, TestDir0, Mod, UserInclude) -> data=TestDir}), {ok,Cwd} = file:get_cwd(), ok = file:set_cwd(TestDir), - TestServerInclude = get_dir(test_server, "include"), CtInclude = get_dir(common_test, "include"), XmerlInclude = get_dir(xmerl, "include"), - ErlFlags = UserInclude ++ [{i,TestServerInclude}, - {i,CtInclude}, + ErlFlags = UserInclude ++ [{i,CtInclude}, {i,XmerlInclude}, debug_info], Result = diff --git a/lib/common_test/src/ct_slave.erl b/lib/common_test/src/ct_slave.erl index 0cd83b9f04..3ad3937548 100644 --- a/lib/common_test/src/ct_slave.erl +++ b/lib/common_test/src/ct_slave.erl @@ -1,7 +1,7 @@ %%-------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2015. All Rights Reserved. +%% Copyright Ericsson AB 2010-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. @@ -315,7 +315,7 @@ enodename(Host, Node) -> do_start(Host, Node, Options) -> ENode = enodename(Host, Node), Functions = - lists:concat([[{ct_slave, slave_started, [ENode, self()]}], + lists:append([[{ct_slave, slave_started, [ENode, self()]}], Options#options.startup_functions, [{ct_slave, slave_ready, [ENode, self()]}]]), Functions2 = if diff --git a/lib/test_server/src/erl2html2.erl b/lib/common_test/src/erl2html2.erl index 2c63103264..e281c9de1b 100644 --- a/lib/test_server/src/erl2html2.erl +++ b/lib/common_test/src/erl2html2.erl @@ -170,23 +170,32 @@ get_line(Anno) -> %%%----------------------------------------------------------------- %%% Find the line number of the last expression in the function find_clause_lines([{clause,CL,_Params,_Op,Exprs}], CLs) -> % last clause - try tuple_to_list(lists:last(Exprs)) of - [_Type,ExprLine | _] when is_integer(ExprLine) -> - {lists:reverse([{clause,get_line(CL)}|CLs]), get_line(ExprLine)}; - [tree,_ | Exprs1] -> + case classify_exprs(Exprs) of + {anno, Anno} -> + {lists:reverse([{clause,get_line(CL)}|CLs]), get_line(Anno)}; + {tree, Exprs1} -> find_clause_lines([{clause,CL,undefined,undefined,Exprs1}], CLs); - [macro,{_var,ExprLine,_MACRO} | _] when is_integer(ExprLine) -> - {lists:reverse([{clause,get_line(CL)}|CLs]), get_line(ExprLine)}; - _ -> - {lists:reverse([{clause,get_line(CL)}|CLs]), get_line(CL)} - catch - _:_ -> + unknown -> {lists:reverse([{clause,get_line(CL)}|CLs]), get_line(CL)} end; - find_clause_lines([{clause,CL,_Params,_Op,_Exprs} | Cs], CLs) -> find_clause_lines(Cs, [{clause,get_line(CL)}|CLs]). +classify_exprs(Exprs) -> + case tuple_to_list(lists:last(Exprs)) of + [macro,{_var,Anno,_MACRO} | _] -> + {anno, Anno}; + [T,ExprAnno | Exprs1] -> + case erl_anno:is_anno(ExprAnno) of + true -> + {anno, ExprAnno}; + false when T =:= tree -> + {tree, Exprs1}; + false -> + unknown + end + end. + %%%----------------------------------------------------------------- %%% Add a link target for each line and one for each function definition. build_html(SFd,DFd,Encoding,FuncsAndCs) -> diff --git a/lib/test_server/src/test_server.app.src b/lib/common_test/src/test_server.app.src index 334be8109d..334be8109d 100644 --- a/lib/test_server/src/test_server.app.src +++ b/lib/common_test/src/test_server.app.src diff --git a/lib/test_server/src/test_server.appup.src b/lib/common_test/src/test_server.appup.src index 7c4aa630ae..7c4aa630ae 100644 --- a/lib/test_server/src/test_server.appup.src +++ b/lib/common_test/src/test_server.appup.src diff --git a/lib/test_server/src/test_server.erl b/lib/common_test/src/test_server.erl index da6bf491ac..73803030a3 100644 --- a/lib/test_server/src/test_server.erl +++ b/lib/common_test/src/test_server.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2015. 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. @@ -411,11 +411,9 @@ run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) -> Ref = make_ref(), Pid = spawn_link( - fun() -> - run_test_case_eval(Mod, Func, Args, Name, Ref, - RunInit, TimetrapData, - LogOpts, TCCallback) - end), + run_test_case_eval_fun(Mod, Func, Args, Name, Ref, + RunInit, TimetrapData, + LogOpts, TCCallback)), put(test_server_detected_fail, []), St = #st{ref=Ref,pid=Pid,mf={Mod,Func},last_known_loc=unknown, status=starting,ret_val=[],comment="",timeout=infinity, @@ -907,6 +905,16 @@ job_proxy_msgloop() -> end, job_proxy_msgloop(). +-spec run_test_case_eval_fun(_, _, _, _, _, _, _, _, _) -> + fun(() -> no_return()). +run_test_case_eval_fun(Mod, Func, Args, Name, Ref, RunInit, + TimetrapData, LogOpts, TCCallback) -> + fun () -> + run_test_case_eval(Mod, Func, Args, Name, Ref, + RunInit, TimetrapData, + LogOpts, TCCallback) + end. + %% A test case is known to have failed if it returns {'EXIT', _} tuple, %% or sends a message {failed, File, Line} to it's group_leader @@ -2408,15 +2416,7 @@ run_on_shielded_node(Fun, CArgs) when is_function(Fun), is_list(CArgs) -> end, Master = self(), Ref = make_ref(), - Slave = spawn(Node, - fun () -> - start_job_proxy(), - receive - Ref -> - Master ! {Ref, Fun()} - end, - receive after infinity -> infinity end - end), + Slave = spawn(Node, start_job_proxy_fun(Master, Fun)), MRef = erlang:monitor(process, Slave), Slave ! Ref, receive @@ -2431,6 +2431,17 @@ run_on_shielded_node(Fun, CArgs) when is_function(Fun), is_list(CArgs) -> end end. +-spec start_job_proxy_fun(_, _) -> fun(() -> no_return()). +start_job_proxy_fun(Master, Fun) -> + fun () -> + start_job_proxy(), + receive + Ref -> + Master ! {Ref, Fun()} + end, + receive after infinity -> infinity end + end. + %% Return true if Name or node() is a shielded node is_shielded(Name) -> case {cast_to_list(Name),atom_to_list(node())} of diff --git a/lib/test_server/src/test_server_ctrl.erl b/lib/common_test/src/test_server_ctrl.erl index 8a46996bc3..cd08a25bd8 100644 --- a/lib/test_server/src/test_server_ctrl.erl +++ b/lib/common_test/src/test_server_ctrl.erl @@ -3163,11 +3163,17 @@ delete_prop([], Props) -> %% Shuffles the order of Cases. shuffle_cases(Ref, Cases, undefined) -> - shuffle_cases(Ref, Cases, ?now); + shuffle_cases(Ref, Cases, rand:seed_s(exsplus)); -shuffle_cases(Ref, [{conf,Ref,_,_}=Start | Cases], Seed) -> +shuffle_cases(Ref, [{conf,Ref,_,_}=Start | Cases], Seed0) -> {N,CasesToShuffle,Rest} = cases_to_shuffle(Ref, Cases), - ShuffledCases = random_order(N, random:uniform_s(N, Seed), CasesToShuffle, []), + Seed = case Seed0 of + {X,Y,Z} when is_integer(X+Y+Z) -> + rand:seed(exsplus, Seed0); + _ -> + Seed0 + end, + ShuffledCases = random_order(N, rand:uniform_s(N, Seed), CasesToShuffle, []), [Start|ShuffledCases] ++ Rest. cases_to_shuffle(Ref, Cases) -> @@ -3201,7 +3207,7 @@ random_order(1, {_Pos,Seed}, [{_Ix,CaseOrGroup}], Shuffled) -> Shuffled++CaseOrGroup; random_order(N, {Pos,NewSeed}, IxCases, Shuffled) -> {First,[{_Ix,CaseOrGroup}|Rest]} = lists:split(Pos-1, IxCases), - random_order(N-1, random:uniform_s(N-1, NewSeed), + random_order(N-1, rand:uniform_s(N-1, NewSeed), First++Rest, Shuffled++CaseOrGroup). diff --git a/lib/test_server/src/test_server_gl.erl b/lib/common_test/src/test_server_gl.erl index c5ec3ccbe6..31098d9726 100644 --- a/lib/test_server/src/test_server_gl.erl +++ b/lib/common_test/src/test_server_gl.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2012-2013. All Rights Reserved. +%% Copyright Ericsson AB 2012-2015. 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. @@ -30,7 +30,7 @@ -export([init/1,handle_call/3,handle_cast/2,handle_info/2,terminate/2]). -record(st, {tc_supervisor :: 'none'|pid(), %Test case supervisor - tc :: mfa(), %Current test case MFA + tc :: mfa() | 'undefined', %Current test case MFA minor :: 'none'|pid(), %Minor fd minor_monitor, %Monitor ref for minor fd capture :: 'none'|pid(), %Capture output diff --git a/lib/test_server/src/test_server_internal.hrl b/lib/common_test/src/test_server_internal.hrl index 578f359010..578f359010 100644 --- a/lib/test_server/src/test_server_internal.hrl +++ b/lib/common_test/src/test_server_internal.hrl diff --git a/lib/test_server/src/test_server_io.erl b/lib/common_test/src/test_server_io.erl index 0d881d0ada..0d881d0ada 100644 --- a/lib/test_server/src/test_server_io.erl +++ b/lib/common_test/src/test_server_io.erl diff --git a/lib/test_server/src/test_server_node.erl b/lib/common_test/src/test_server_node.erl index 4e6839fc6b..c12832e0d0 100644 --- a/lib/test_server/src/test_server_node.erl +++ b/lib/common_test/src/test_server_node.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2014. All Rights Reserved. +%% 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. @@ -121,7 +121,7 @@ start_tracer_node(TraceFile,TI) -> %%% trace_nodes(Sock,Nodes) -> Bin = term_to_binary({add_nodes,Nodes}), - ok = gen_tcp:send(Sock, [1|Bin]), + ok = gen_tcp:send(Sock, tag_trace_message(Bin)), receive_ack(Sock). @@ -142,7 +142,7 @@ receive_ack(Sock) -> %%% stop_tracer_node(Sock) -> Bin = term_to_binary(id(stop)), - ok = gen_tcp:send(Sock, [1|Bin]), + ok = gen_tcp:send(Sock, tag_trace_message(Bin)), receive {tcp_closed,Sock} -> gen_tcp:close(Sock) end, ok. @@ -171,7 +171,7 @@ trc([TraceFile, PortAtom, Type]) -> {packet,2}]) of {ok,Sock} -> BinResult = term_to_binary(Result), - ok = gen_tcp:send(Sock,[1|BinResult]), + ok = gen_tcp:send(Sock,tag_trace_message(BinResult)), trc_loop(Sock,Patterns,Type); _else -> ok @@ -187,7 +187,7 @@ trc_loop(Sock,Patterns,Type) -> {ok,{add_nodes,Nodes}} -> add_nodes(Nodes,Patterns,Type), Bin = term_to_binary(id(ok)), - ok = gen_tcp:send(Sock, [1|Bin]), + ok = gen_tcp:send(Sock, tag_trace_message(Bin)), trc_loop(Sock,Patterns,Type); {ok,stop} -> ttb:stop(), @@ -354,15 +354,18 @@ start_node_peer(SlaveName, OptList, From, TI) -> I = "=== Not waiting for node", gen_server:reply(From,{{ok, Nodename}, HostStr, Cmd, I, []}), Self = self(), - spawn_link( - fun() -> - wait_for_node_started(LSock,Tmo,undefined, - Cleanup,TI,Self), - receive after infinity -> ok end - end), + spawn_link(wait_for_node_started_fun(LSock,Tmo,Cleanup,TI,Self)), ok end. +-spec wait_for_node_started_fun(_, _, _, _, _) -> fun(() -> no_return()). +wait_for_node_started_fun(LSock, Tmo, Cleanup, TI, Self) -> + fun() -> + wait_for_node_started(LSock,Tmo,undefined, + Cleanup,TI,Self), + receive after infinity -> ok end + end. + %% %% Slave nodes are started on a remote host if %% - the option remote is given when calling test_server:start_node/3 @@ -468,7 +471,11 @@ handle_start_node_return(Version,VsnStr,{started, Node, OVersion, OVsnStr}) -> node_started([Host,PortAtom]) -> %% Must spawn a new process because the boot process should not %% hang forever!! - spawn(fun() -> node_started(Host,PortAtom) end). + spawn(node_started_fun(Host,PortAtom)). + +-spec node_started_fun(_, _) -> fun(() -> no_return()). +node_started_fun(Host,PortAtom) -> + fun() -> node_started(Host,PortAtom) end. %% This process hangs forever, just waiting for the socket to be %% closed and terminating the node @@ -482,7 +489,7 @@ node_started(Host,PortAtom) -> {ok,Sock} -> Started = term_to_binary({started, node(), Version, VsnStr}), - ok = gen_tcp:send(Sock, [1|Started]), + ok = gen_tcp:send(Sock, tag_trace_message(Started)), receive _Anyting -> gen_tcp:close(Sock), erlang:halt() @@ -492,8 +499,10 @@ node_started(Host,PortAtom) -> end. - - +-compile({inline, [tag_trace_message/1]}). +-dialyzer({no_improper_lists, tag_trace_message/1}). +tag_trace_message(M) -> + [1|M]. % start_which_node(Optlist) -> hostname start_which_node(Optlist) -> @@ -619,8 +628,7 @@ do_quote_progname([Prog,Arg|Args]) -> end. random_element(L) -> - random:seed(os:timestamp()), - lists:nth(random:uniform(length(L)), L). + lists:nth(rand:uniform(length(L)), L). find_release(latest) -> "/usr/local/otp/releases/latest/bin/erl"; diff --git a/lib/test_server/src/test_server_sup.erl b/lib/common_test/src/test_server_sup.erl index fc2cfd57bd..fc2cfd57bd 100644 --- a/lib/test_server/src/test_server_sup.erl +++ b/lib/common_test/src/test_server_sup.erl diff --git a/lib/common_test/test/Makefile b/lib/common_test/test/Makefile index ff4495b104..aa99fe1af1 100644 --- a/lib/common_test/test/Makefile +++ b/lib/common_test/test/Makefile @@ -65,9 +65,13 @@ MODULES= \ ct_cover_nomerge_SUITE \ ct_groups_search_SUITE \ ct_surefire_SUITE \ - ct_telnet_SUITE + ct_telnet_SUITE \ + erl2html2_SUITE \ + test_server_SUITE \ + test_server_test_lib ERL_FILES= $(MODULES:%=%.erl) +HRL_FILES= test_server_test_lib.hrl TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) INSTALL_PROGS= $(TARGET_FILES) @@ -84,8 +88,8 @@ RELSYSDIR = $(RELEASE_PATH)/common_test_test # FLAGS # ---------------------------------------------------- -ERL_MAKE_FLAGS += -pa $(ERL_TOP)/lib/test_server/ebin -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +ERL_MAKE_FLAGS += +ERL_COMPILE_FLAGS += EBIN = . @@ -118,7 +122,7 @@ release_spec: opt release_tests_spec: $(INSTALL_DIR) "$(RELSYSDIR)" - $(INSTALL_DATA) $(ERL_FILES) $(COVERFILE) "$(RELSYSDIR)" + $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(COVERFILE) "$(RELSYSDIR)" $(INSTALL_DATA) common_test.spec common_test.cover "$(RELSYSDIR)" chmod -R u+w "$(RELSYSDIR)" @tar cf - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -) diff --git a/lib/common_test/test/common_test.cover b/lib/common_test/test/common_test.cover index 87d00c420f..e8e01a9312 100644 --- a/lib/common_test/test/common_test.cover +++ b/lib/common_test/test/common_test.cover @@ -1,9 +1,2 @@ %% -*- erlang -*- {incl_app,common_test,details}. -{cross,common_test,[{test_server,[erl2html2, - test_server, - test_server_ctrl, - test_server_gl, - test_server_io, - test_server_node, - test_server_sup]}]}. diff --git a/lib/common_test/test/ct_event_handler_SUITE_data/eh_A.erl b/lib/common_test/test/ct_event_handler_SUITE_data/eh_A.erl index 28c85ee2db..29c25bf151 100644 --- a/lib/common_test/test/ct_event_handler_SUITE_data/eh_A.erl +++ b/lib/common_test/test/ct_event_handler_SUITE_data/eh_A.erl @@ -27,7 +27,7 @@ -behaviour(gen_event). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("common_test/include/ct_event.hrl"). %% gen_event callbacks diff --git a/lib/common_test/test/ct_hooks_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE.erl index f00b2bbb43..06bc0c07f4 100644 --- a/lib/common_test/test/ct_hooks_SUITE.erl +++ b/lib/common_test/test/ct_hooks_SUITE.erl @@ -30,7 +30,7 @@ -compile(export_all). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("common_test/include/ct_event.hrl"). -define(eh, ct_test_support_eh). diff --git a/lib/common_test/test/ct_master_SUITE.erl b/lib/common_test/test/ct_master_SUITE.erl index 15b49c67c0..55837352e2 100644 --- a/lib/common_test/test/ct_master_SUITE.erl +++ b/lib/common_test/test/ct_master_SUITE.erl @@ -135,7 +135,7 @@ make_spec(DataDir, FileName, NodeNames, Suites, Config) -> C = lists:map( fun(NodeName) -> - Rnd = random:uniform(2), + Rnd = rand:uniform(2), if Rnd == 1-> {config,NodeName,filename:join(DataDir, "master/config.txt")}; diff --git a/lib/common_test/test/ct_misc_1_SUITE.erl b/lib/common_test/test/ct_misc_1_SUITE.erl index 1db8bcc794..a562719296 100644 --- a/lib/common_test/test/ct_misc_1_SUITE.erl +++ b/lib/common_test/test/ct_misc_1_SUITE.erl @@ -31,7 +31,6 @@ -compile(export_all). -include_lib("common_test/include/ct.hrl"). --include_lib("test_server/include/test_server_line.hrl"). -include_lib("common_test/include/ct_event.hrl"). -define(eh, ct_test_support_eh). diff --git a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl index ea49e36608..49b02d2bba 100644 --- a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl +++ b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl @@ -99,7 +99,10 @@ all() -> connection_crash, get_event_streams, create_subscription, - receive_event + receive_one_event, + receive_multiple_events, + receive_event_and_rpc, + receive_event_and_rpc_in_chunks ] end. @@ -354,7 +357,7 @@ get(Config) -> get_a_lot(Config) -> DataDir = ?config(data_dir,Config), {ok,Client} = open_success(DataDir), - Descr = lists:append(lists:duplicate(100,"Description of myserver! ")), + Descr = lists:append(lists:duplicate(1000,"Description of myserver! ")), Server = {server,[{xmlns,"myns"}],[{name,[],["myserver"]}, {description,[],[Descr]}]}, Data = lists:duplicate(100,Server), @@ -964,16 +967,16 @@ create_subscription(Config) -> ok. -receive_event(Config) -> +receive_one_event(Config) -> DataDir = ?config(data_dir,Config), {ok,Client} = open_success(DataDir), ?NS:expect_reply({'create-subscription',[stream]},ok), ?ok = ct_netconfc:create_subscription(Client), - ?NS:hupp(send_event), + ?NS:hupp({send_events,1}), receive - %% Matching ?NS:make_msg(event) + %% Matching ?NS:make_msg({event,_}) {notification,?NETCONF_NOTIF_NAMESPACE_ATTR, [{eventTime,[],[_Time]}, {event,[{xmlns,"http://my.namespaces.com/event"}], @@ -991,6 +994,187 @@ receive_event(Config) -> ok. +receive_multiple_events(Config) -> + DataDir = ?config(data_dir,Config), + {ok,Client} = open_success(DataDir), + ?NS:expect_reply({'create-subscription',[stream]},ok), + ?ok = ct_netconfc:create_subscription(Client), + + ?NS:hupp({send_events,3}), + + receive + %% Matching ?NS:make_msg({event,_}) + {notification,_,_} -> + ok; + Other1 -> + ct:fail({got_unexpected_while_waiting_for_event, Other1}) + after 3000 -> + ct:fail(timeout_waiting_for_event) + end, + receive + %% Matching ?NS:make_msg({event,_}) + {notification,_,_} -> + ok; + Other2 -> + ct:fail({got_unexpected_while_waiting_for_event, Other2}) + after 3000 -> + ct:fail(timeout_waiting_for_event) + end, + receive + %% Matching ?NS:make_msg({event,_}) + {notification,_,_} -> + ok; + Other3 -> + ct:fail({got_unexpected_while_waiting_for_event, Other3}) + after 3000 -> + ct:fail(timeout_waiting_for_event) + end, + + ?NS:expect_do_reply('close-session',close,ok), + ?ok = ct_netconfc:close_session(Client), + + ok. + +receive_event_and_rpc(Config) -> + DataDir = ?config(data_dir,Config), + {ok,Client} = open_success(DataDir), + + ?NS:expect_reply({'create-subscription',[stream]},ok), + ?ok = ct_netconfc:create_subscription(Client), + + %% Construct the data to return from netconf server - one + %% rpc-reply and one notification - to be sent in the same ssh + %% package. + Data = [{servers,[{xmlns,"myns"}],[{server,[],[{name,[],["myserver"]}]}]}], + Rpc = {'rpc-reply',?NETCONF_NAMESPACE_ATTR ++ [{'message-id',"2"}], + [{data,Data}]}, + RpcXml = list_to_binary(xmerl:export_simple_element(Rpc,xmerl_xml)), + + Notification = + {notification,?NETCONF_NOTIF_NAMESPACE_ATTR, + [{eventTime,["2012-06-14T14:50:54+02:00"]}, + {event,[{xmlns,"http://my.namespaces.com/event"}], + [{severity,["major"]}, + {description,["Something terrible happened"]}]}]}, + NotifXml = + list_to_binary(xmerl:export_simple_element(Notification,xmerl_xml)), + + ?NS:expect_reply('get',[RpcXml,NotifXml]), + {ok,Data} = ct_netconfc:get(Client,{server,[{xmlns,"myns"}],[]}), + + receive + {notification,_,_} -> + ok; + Other1 -> + ct:fail({got_unexpected_while_waiting_for_event, Other1}) + after 3000 -> + ct:fail(timeout_waiting_for_event) + end, + + + %% Then do the same again, but now send notification first then + %% the rpc-reply. + Rpc2 = {'rpc-reply',?NETCONF_NAMESPACE_ATTR ++ [{'message-id',"3"}], + [{data,Data}]}, + RpcXml2 = list_to_binary(xmerl:export_simple_element(Rpc2,xmerl_xml)), + ?NS:expect_reply('get',[NotifXml,RpcXml2]), + {ok,Data} = ct_netconfc:get(Client,{server,[{xmlns,"myns"}],[]}), + + receive + {notification,_,_} -> + ok; + Other2 -> + ct:fail({got_unexpected_while_waiting_for_event, Other2}) + after 3000 -> + ct:fail(timeout_waiting_for_event) + end, + + ?NS:expect_do_reply('close-session',close,ok), + ?ok = ct_netconfc:close_session(Client), + + ok. + + +receive_event_and_rpc_in_chunks(Config) -> + DataDir = ?config(data_dir,Config), + {ok,Client} = open_success(DataDir), + + ?NS:expect_reply({'create-subscription',[stream]},ok), + ?ok = ct_netconfc:create_subscription(Client), + + %% Construct the data to return from netconf server + Data = [{servers,[{xmlns,"myns"}], + [{server,[],[{name,[],["server0"]}]}, + {server,[],[{name,[],["server1"]}]}, + {server,[],[{name,[],["server2"]}]}, + {server,[],[{name,[],["server3"]}]}, + {server,[],[{name,[],["server4"]}]}, + {server,[],[{name,[],["server5"]}]}, + {server,[],[{name,[],["server6"]}]}, + {server,[],[{name,[],["server7"]}]}, + {server,[],[{name,[],["server8"]}]}, + {server,[],[{name,[],["server9"]}]}] + }], + Rpc = {'rpc-reply',?NETCONF_NAMESPACE_ATTR ++ [{'message-id',"2"}], + [{data,Data}]}, + RpcXml = list_to_binary(xmerl:export_simple_element(Rpc,xmerl_xml)), + + Notification = + {notification,?NETCONF_NOTIF_NAMESPACE_ATTR, + [{eventTime,["2012-06-14T14:50:54+02:00"]}, + {event,[{xmlns,"http://my.namespaces.com/event"}], + [{severity,["major"]}, + {description,["Something terrible happened"]}]}]}, + NotifXml = + list_to_binary(xmerl:export_simple_element(Notification,xmerl_xml)), + + + %% First part contains a notif, but only parts of the end tag + Part1 = + <<"<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n", + NotifXml/binary,"\n]]">>, + + %% Second part contains rest of end tag, full rpc-reply and full + %% notif except end tag + Part2 = + <<">]]>\n",RpcXml/binary,"\n",?END_TAG/binary,NotifXml/binary>>, + + %% Third part contains last end tag + Part3 = <<"\n",?END_TAG/binary,"\n">>, + + %% Spawn a process which will wait a bit for the client to send + %% the request (below), then order the server to the chunks of the + %% rpc-reply one by one. + spawn(fun() -> ct:sleep(500),?NS:hupp(send,Part1), + ct:sleep(100),?NS:hupp(send,Part2), + ct:sleep(100),?NS:hupp(send,Part3) + end), + + %% Order server to expect a get - then the process above will make + %% sure the rpc-reply is sent. + ?NS:expect('get'), + {ok,Data} = ct_netconfc:get(Client,{server,[{xmlns,"myns"}],[]}), + + receive + {notification,_,_} -> + ok; + Other1 -> + ct:fail({got_unexpected_while_waiting_for_event, Other1}) + after 3000 -> + ct:fail(timeout_waiting_for_event) + end, + receive + {notification,_,_} -> + ok; + Other2 -> + ct:fail({got_unexpected_while_waiting_for_event, Other2}) + after 3000 -> + ct:fail(timeout_waiting_for_event) + end, + ?NS:expect_do_reply('close-session',close,ok), + ?ok = ct_netconfc:close_session(Client), + ok. + %%%----------------------------------------------------------------- break(_Config) -> diff --git a/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl b/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl index 07893faabc..67827a053f 100644 --- a/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl +++ b/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl @@ -144,8 +144,8 @@ expect_do_reply(SessionId,Expect,Do,Reply) -> %% Hupp the server - i.e. tell it to do something - %% e.g. hupp(send_event) will cause send_event(State) to be called on %% the session channel process. -hupp(send_event) -> - hupp(send,[make_msg(event)]); +hupp({send_events,N}) -> + hupp(send,[make_msg({event,N})]); hupp(kill) -> hupp(1,fun hupp_kill/1,[]). @@ -446,9 +446,12 @@ reply(ConnRef,Reply) -> from_simple(Simple) -> unicode_c2b(xmerl:export_simple_element(Simple,xmerl_xml)). -xml(Content) -> - <<"<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n", - Content/binary,"\n",?END_TAG/binary>>. +xml(Content) when is_binary(Content) -> + xml([Content]); +xml(Content) when is_list(Content) -> + Msgs = [<<Msg/binary,"\n",?END_TAG/binary>> || Msg <- Content], + MsgsBin = list_to_binary(Msgs), + <<"<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n", MsgsBin/binary>>. rpc_reply(Content) when is_binary(Content) -> MsgId = case erase(msg_id) of @@ -571,15 +574,17 @@ make_msg({ok,Data}) -> make_msg({data,Data}) -> xml(rpc_reply(from_simple({data,Data}))); -make_msg(event) -> - xml(<<"<notification xmlns=\"",?NETCONF_NOTIF_NAMESPACE,"\">" +make_msg({event,N}) -> + Notification = <<"<notification xmlns=\"",?NETCONF_NOTIF_NAMESPACE,"\">" "<eventTime>2012-06-14T14:50:54+02:00</eventTime>" "<event xmlns=\"http://my.namespaces.com/event\">" "<severity>major</severity>" "<description>Something terrible happened</description>" "</event>" - "</notification>">>); -make_msg(Xml) when is_binary(Xml) -> + "</notification>">>, + xml(lists:duplicate(N,Notification)); +make_msg(Xml) when is_binary(Xml) orelse + (is_list(Xml) andalso is_binary(hd(Xml))) -> xml(Xml); make_msg(Simple) when is_tuple(Simple) -> xml(from_simple(Simple)). diff --git a/lib/common_test/test/ct_test_support.erl b/lib/common_test/test/ct_test_support.erl index 248ec6c4df..4a47d345e9 100644 --- a/lib/common_test/test/ct_test_support.erl +++ b/lib/common_test/test/ct_test_support.erl @@ -414,14 +414,14 @@ ct_rpc({M,F,A}, Config) -> %%%----------------------------------------------------------------- %%% random_error/1 random_error(Config) when is_list(Config) -> - random:seed(os:timestamp()), + rand:seed(exsplus), Gen = fun(0,_) -> ok; (N,Fun) -> Fun(N-1, Fun) end, - Gen(random:uniform(100), Gen), + Gen(rand:uniform(100), Gen), ErrorTypes = ['BADMATCH','BADARG','CASE_CLAUSE','FUNCTION_CLAUSE', 'EXIT','THROW','UNDEF'], - Type = lists:nth(random:uniform(length(ErrorTypes)), ErrorTypes), - Where = case random:uniform(2) of + Type = lists:nth(rand:uniform(length(ErrorTypes)), ErrorTypes), + Where = case rand:uniform(2) of 1 -> io:format("ct_test_support *returning* error of type ~w", [Type]), diff --git a/lib/common_test/test/ct_test_support_eh.erl b/lib/common_test/test/ct_test_support_eh.erl index 7c3d137901..f3d933da04 100644 --- a/lib/common_test/test/ct_test_support_eh.erl +++ b/lib/common_test/test/ct_test_support_eh.erl @@ -27,7 +27,7 @@ -behaviour(gen_event). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("common_test/include/ct_event.hrl"). %% gen_event callbacks diff --git a/lib/test_server/test/erl2html2_SUITE.erl b/lib/common_test/test/erl2html2_SUITE.erl index 9e6389109b..9e6389109b 100644 --- a/lib/test_server/test/erl2html2_SUITE.erl +++ b/lib/common_test/test/erl2html2_SUITE.erl diff --git a/lib/test_server/test/erl2html2_SUITE_data/Makefile.src b/lib/common_test/test/erl2html2_SUITE_data/Makefile.src index 942ac0584b..942ac0584b 100644 --- a/lib/test_server/test/erl2html2_SUITE_data/Makefile.src +++ b/lib/common_test/test/erl2html2_SUITE_data/Makefile.src diff --git a/lib/test_server/test/erl2html2_SUITE_data/header1.hrl b/lib/common_test/test/erl2html2_SUITE_data/header1.hrl index 53d1b79ac5..53d1b79ac5 100644 --- a/lib/test_server/test/erl2html2_SUITE_data/header1.hrl +++ b/lib/common_test/test/erl2html2_SUITE_data/header1.hrl diff --git a/lib/test_server/test/erl2html2_SUITE_data/include/header2.hrl b/lib/common_test/test/erl2html2_SUITE_data/include/header2.hrl index e69de29bb2..e69de29bb2 100644 --- a/lib/test_server/test/erl2html2_SUITE_data/include/header2.hrl +++ b/lib/common_test/test/erl2html2_SUITE_data/include/header2.hrl diff --git a/lib/test_server/test/erl2html2_SUITE_data/include/header3.hrl b/lib/common_test/test/erl2html2_SUITE_data/include/header3.hrl index 2a20850a3a..2a20850a3a 100644 --- a/lib/test_server/test/erl2html2_SUITE_data/include/header3.hrl +++ b/lib/common_test/test/erl2html2_SUITE_data/include/header3.hrl diff --git a/lib/test_server/test/erl2html2_SUITE_data/m1.erl b/lib/common_test/test/erl2html2_SUITE_data/m1.erl index 1d405963a5..1d405963a5 100644 --- a/lib/test_server/test/erl2html2_SUITE_data/m1.erl +++ b/lib/common_test/test/erl2html2_SUITE_data/m1.erl diff --git a/lib/test_server/test/test_server_SUITE.erl b/lib/common_test/test/test_server_SUITE.erl index 6adf5b8a78..d1c789f34c 100644 --- a/lib/test_server/test/test_server_SUITE.erl +++ b/lib/common_test/test/test_server_SUITE.erl @@ -330,7 +330,7 @@ generate_and_run_unicode_test(Config0,Encoding) -> %% Compile the suite Node = proplists:get_value(node,Config), - {ok,Mod} = rpc:call(Node,compile,file,[Suite,[{outdir,DataDir}]]), + {ok,Mod} = rpc:call(Node,compile,file,[Suite,[report,{outdir,DataDir}]]), ModStr = atom_to_list(Mod), %% Clean logdir @@ -383,7 +383,7 @@ create_unicode_test_suite(Dir,Encoding) -> "-export([init_per_testcase/2, end_per_testcase/2]).\n" "-export([tc_äöå/1]).\n" "\n" - "-include_lib(\"test_server/include/test_server.hrl\").\n" + "-include_lib(\"common_test/include/ct.hrl\").\n" "\n" "all(suite) ->\n" " [tc_äöå].\n" diff --git a/lib/test_server/test/test_server_SUITE_data/Makefile.src b/lib/common_test/test/test_server_SUITE_data/Makefile.src index 5aeb035572..5aeb035572 100644 --- a/lib/test_server/test/test_server_SUITE_data/Makefile.src +++ b/lib/common_test/test/test_server_SUITE_data/Makefile.src diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_SUITE.erl b/lib/common_test/test/test_server_SUITE_data/test_server_SUITE.erl index 79d8defb22..c3d4315cb8 100644 --- a/lib/test_server/test/test_server_SUITE_data/test_server_SUITE.erl +++ b/lib/common_test/test/test_server_SUITE_data/test_server_SUITE.erl @@ -22,8 +22,7 @@ %%% Test Server self test. %%%------------------------------------------------------------------ -module(test_server_SUITE). --include_lib("test_server/include/test_server.hrl"). --include_lib("test_server/include/test_server_line.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). -export([all/1]). diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_SUITE_data/dummy_file b/lib/common_test/test/test_server_SUITE_data/test_server_SUITE_data/dummy_file index 65c88fbd75..65c88fbd75 100644 --- a/lib/test_server/test/test_server_SUITE_data/test_server_SUITE_data/dummy_file +++ b/lib/common_test/test/test_server_SUITE_data/test_server_SUITE_data/dummy_file diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_break_SUITE.erl b/lib/common_test/test/test_server_SUITE_data/test_server_break_SUITE.erl index ae9f018bc8..171f83df0f 100644 --- a/lib/test_server/test/test_server_SUITE_data/test_server_break_SUITE.erl +++ b/lib/common_test/test/test_server_SUITE_data/test_server_break_SUITE.erl @@ -28,7 +28,7 @@ break_in_end_tc_after_abort/1, check_all_breaks/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). all(suite) -> [break_in_init_tc, diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_conf01_SUITE.erl b/lib/common_test/test/test_server_SUITE_data/test_server_conf01_SUITE.erl index f634bc3a46..e4f40f6c03 100644 --- a/lib/test_server/test/test_server_SUITE_data/test_server_conf01_SUITE.erl +++ b/lib/common_test/test/test_server_SUITE_data/test_server_conf01_SUITE.erl @@ -22,7 +22,7 @@ %%% Test Server self test. %%%------------------------------------------------------------------ -module(test_server_conf01_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -compile(export_all). diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_conf02_SUITE.erl b/lib/common_test/test/test_server_SUITE_data/test_server_conf02_SUITE.erl index f9cca8653b..1c6fe6dd0b 100644 --- a/lib/test_server/test/test_server_SUITE_data/test_server_conf02_SUITE.erl +++ b/lib/common_test/test/test_server_SUITE_data/test_server_conf02_SUITE.erl @@ -22,7 +22,7 @@ %%% Test Server self test. %%%------------------------------------------------------------------ -module(test_server_conf02_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -compile(export_all). diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_cover_SUITE.erl b/lib/common_test/test/test_server_SUITE_data/test_server_cover_SUITE.erl index ab5ccec7a2..3371418980 100644 --- a/lib/test_server/test/test_server_SUITE_data/test_server_cover_SUITE.erl +++ b/lib/common_test/test/test_server_SUITE_data/test_server_cover_SUITE.erl @@ -23,7 +23,7 @@ -export([init_per_testcase/2, end_per_testcase/2]). -export([tc1/1, tc2/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). all(suite) -> [tc1,tc2]. diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_cover_SUITE_data/cover_helper.erl b/lib/common_test/test/test_server_SUITE_data/test_server_cover_SUITE_data/cover_helper.erl index 6c74eb4e8a..6c74eb4e8a 100644 --- a/lib/test_server/test/test_server_SUITE_data/test_server_cover_SUITE_data/cover_helper.erl +++ b/lib/common_test/test/test_server_SUITE_data/test_server_cover_SUITE_data/cover_helper.erl diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_parallel01_SUITE.erl b/lib/common_test/test/test_server_SUITE_data/test_server_parallel01_SUITE.erl index 0385435710..ad639b585d 100644 --- a/lib/test_server/test/test_server_SUITE_data/test_server_parallel01_SUITE.erl +++ b/lib/common_test/test/test_server_SUITE_data/test_server_parallel01_SUITE.erl @@ -22,7 +22,7 @@ %%% Test Server self test. %%%------------------------------------------------------------------ -module(test_server_parallel01_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -compile(export_all). diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_shuffle01_SUITE.erl b/lib/common_test/test/test_server_SUITE_data/test_server_shuffle01_SUITE.erl index 847c7b6bdd..0f7118a810 100644 --- a/lib/test_server/test/test_server_SUITE_data/test_server_shuffle01_SUITE.erl +++ b/lib/common_test/test/test_server_SUITE_data/test_server_shuffle01_SUITE.erl @@ -22,7 +22,7 @@ %%% Test Server self test. %%%------------------------------------------------------------------ -module(test_server_shuffle01_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -compile(export_all). @@ -224,7 +224,7 @@ conf5_end(_Config) -> ok. conf6_init(Config) when is_list(Config) -> - [{shuffle,{_,_,_}}] = ?config(tc_group_properties,Config), + validate_shuffle(Config), test_server:comment("Shuffle (random)"), init = ?config(suite,Config), [{cc6,conf6}|Config]. @@ -242,23 +242,28 @@ conf5(suite) -> % test specification conf7_init(Config) when is_list(Config) -> test_server:comment("Group 7, Shuffle (random seed)"), - case proplists:get_value(shuffle,?config(tc_group_properties,Config)) of - {_,_,_} -> ok - end, + validate_shuffle(Config), [{cc7,conf7}|Config]. conf7_end(_Config) -> ok. conf8_init(Config) when is_list(Config) -> test_server:comment("Group 8, Shuffle (user start seed)"), - case proplists:get_value(shuffle,?config(tc_group_properties,Config)) of - {_,_,_} -> ok - end, + validate_shuffle(Config), init = ?config(suite,Config), [{cc8,conf8}|Config]. conf8_end(_Config) -> ok. +validate_shuffle(Config) -> + case proplists:get_value(shuffle, ?config(tc_group_properties,Config)) of + {_,_,_} -> + ok; + Seed -> + %% Must be a valid seed. + _ = rand:seed_s(rand:export_seed_s(Seed)) + end. + %%---------- test cases ---------- diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_skip_SUITE.erl b/lib/common_test/test/test_server_SUITE_data/test_server_skip_SUITE.erl index 871bd21ee7..ae2321c6ad 100644 --- a/lib/test_server/test/test_server_SUITE_data/test_server_skip_SUITE.erl +++ b/lib/common_test/test/test_server_SUITE_data/test_server_skip_SUITE.erl @@ -22,8 +22,7 @@ -export([all/1, init_per_suite/1, end_per_suite/1]). -export([dummy/1]). --include_lib("test_server/include/test_server.hrl"). --include_lib("test_server/include/test_server_line.hrl"). +-include_lib("common_test/include/ct.hrl"). all(suite) -> [dummy]. diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_unicode_SUITE.erl b/lib/common_test/test/test_server_SUITE_data/test_server_unicode_SUITE.erl index 3a3366218b..0cabce995f 100644 --- a/lib/test_server/test/test_server_SUITE_data/test_server_unicode_SUITE.erl +++ b/lib/common_test/test/test_server_SUITE_data/test_server_unicode_SUITE.erl @@ -25,7 +25,7 @@ print_and_log_unicode/1, print_and_log_latin1/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). all(suite) -> ['#=@: difficult_case_name_äöå', diff --git a/lib/test_server/test/test_server_test_lib.erl b/lib/common_test/test/test_server_test_lib.erl index e2680938e0..e2680938e0 100644 --- a/lib/test_server/test/test_server_test_lib.erl +++ b/lib/common_test/test/test_server_test_lib.erl diff --git a/lib/test_server/test/test_server_test_lib.hrl b/lib/common_test/test/test_server_test_lib.hrl index 27b7be9618..27b7be9618 100644 --- a/lib/test_server/test/test_server_test_lib.hrl +++ b/lib/common_test/test/test_server_test_lib.hrl diff --git a/lib/webtool/src/Makefile b/lib/common_test/test_server/Makefile index a5a8eaf5dc..0adf64b837 100644 --- a/lib/webtool/src/Makefile +++ b/lib/common_test/test_server/Makefile @@ -1,8 +1,8 @@ # # %CopyrightBegin% -# -# Copyright Ericsson AB 2001-2012. All Rights Reserved. -# +# +# Copyright Ericsson AB 1996-2013. 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,85 +14,83 @@ # 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_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../vsn.mk -VSN=$(WEBTOOL_VSN) +include $(ERL_TOP)/make/target.mk # ---------------------------------------------------- -# Release directory specification +# Configuration info. # ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/webtool-$(VSN) +include $(ERL_TOP)/make/$(TARGET)/otp.mk # ---------------------------------------------------- # Target Specs # ---------------------------------------------------- -MODULES= webtool \ - webtool_sup - - - -ERL_FILES= $(MODULES:%=%.erl) +EBIN=. -TARGET_FILES = $(MODULES:%=$(EBIN)/%.$(EMULATOR)) +TS_MODULES= \ + ts \ + ts_run \ + ts_lib \ + ts_make \ + ts_erl_config \ + ts_autoconf_win32 \ + ts_install \ + ts_install_cth \ + ts_benchmark -APP_FILE= webtool.app -APPUP_FILE= webtool.appup +TARGET_MODULES= $(MODULES:%=$(EBIN)/%) +TS_TARGET_MODULES= $(TS_MODULES:%=$(EBIN)/%) -APP_SRC= $(APP_FILE).src -APPUP_SRC= $(APPUP_FILE).src +TS_ERL_FILES = $(TS_MODULES:=.erl) +TS_HRL_FILES = ts.hrl +AUTOCONF_FILES = configure.in conf_vars.in +PROGRAMS = configure config.sub config.guess install-sh +CONFIG = ts.config ts.unix.config ts.win32.config +TS_TARGET_FILES = $(TS_MODULES:%=$(EBIN)/%.$(EMULATOR)) -APP_TARGET= $(EBIN)/$(APP_FILE) -APPUP_TARGET= $(EBIN)/$(APPUP_FILE) +TS_TARGETS = $(TS_MODULES:%=$(EBIN)/%.$(EMULATOR)) # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- -ERL_COMPILE_FLAGS += +warn_obsolete_guard - +ERL_COMPILE_FLAGS += -I../include -Werror # ---------------------------------------------------- # Targets # ---------------------------------------------------- -debug opt: $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) +tests debug opt: $(TS_TARGETS) clean: - rm -f $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) + rm -f $(TS_TARGET_FILES) rm -f core docs: +configure: configure.in + autoconf configure.in > configure + # ---------------------------------------------------- # Special Build Targets # ---------------------------------------------------- -$(APP_TARGET): $(APP_SRC) ../vsn.mk - $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@ - -$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk - $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@ - # ---------------------------------------------------- # Release Target # ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk -release_spec: opt - $(INSTALL_DIR) "$(RELSYSDIR)/src" - $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) "$(RELSYSDIR)/src" - $(INSTALL_DIR) "$(RELSYSDIR)/ebin" - $(INSTALL_DATA) $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) \ - "$(RELSYSDIR)/ebin" +release_tests_spec: opt + $(INSTALL_DIR) "$(RELEASE_PATH)/test_server" + $(INSTALL_DATA) $(TS_ERL_FILES) $(TS_HRL_FILES) \ + $(TS_TARGET_FILES) \ + $(AUTOCONF_FILES) $(CONFIG) \ + "$(RELEASE_PATH)/test_server" + $(INSTALL_SCRIPT) $(PROGRAMS) "$(RELEASE_PATH)/test_server" release_docs_spec: diff --git a/lib/test_server/src/conf_vars.in b/lib/common_test/test_server/conf_vars.in index 7c55d7b9ed..7c55d7b9ed 100644 --- a/lib/test_server/src/conf_vars.in +++ b/lib/common_test/test_server/conf_vars.in diff --git a/lib/test_server/src/configure.in b/lib/common_test/test_server/configure.in index 001de72a1e..001de72a1e 100644 --- a/lib/test_server/src/configure.in +++ b/lib/common_test/test_server/configure.in diff --git a/lib/test_server/src/cross.cover b/lib/common_test/test_server/cross.cover index 07bf0bed5c..07bf0bed5c 100644 --- a/lib/test_server/src/cross.cover +++ b/lib/common_test/test_server/cross.cover diff --git a/lib/test_server/src/ts.config b/lib/common_test/test_server/ts.config index cf3d269616..cf3d269616 100644 --- a/lib/test_server/src/ts.config +++ b/lib/common_test/test_server/ts.config diff --git a/lib/test_server/src/ts.erl b/lib/common_test/test_server/ts.erl index 8bbdc8f8cf..8bbdc8f8cf 100644 --- a/lib/test_server/src/ts.erl +++ b/lib/common_test/test_server/ts.erl diff --git a/lib/test_server/src/ts.hrl b/lib/common_test/test_server/ts.hrl index 4c940fdc4f..4c940fdc4f 100644 --- a/lib/test_server/src/ts.hrl +++ b/lib/common_test/test_server/ts.hrl diff --git a/lib/test_server/src/ts.unix.config b/lib/common_test/test_server/ts.unix.config index 1ba5d9033e..1ba5d9033e 100644 --- a/lib/test_server/src/ts.unix.config +++ b/lib/common_test/test_server/ts.unix.config diff --git a/lib/test_server/src/ts.win32.config b/lib/common_test/test_server/ts.win32.config index cae587bea8..cae587bea8 100644 --- a/lib/test_server/src/ts.win32.config +++ b/lib/common_test/test_server/ts.win32.config diff --git a/lib/test_server/src/ts_autoconf_win32.erl b/lib/common_test/test_server/ts_autoconf_win32.erl index 288305b406..288305b406 100644 --- a/lib/test_server/src/ts_autoconf_win32.erl +++ b/lib/common_test/test_server/ts_autoconf_win32.erl diff --git a/lib/test_server/src/ts_benchmark.erl b/lib/common_test/test_server/ts_benchmark.erl index 3e55edefb0..3e55edefb0 100644 --- a/lib/test_server/src/ts_benchmark.erl +++ b/lib/common_test/test_server/ts_benchmark.erl diff --git a/lib/test_server/src/ts_erl_config.erl b/lib/common_test/test_server/ts_erl_config.erl index ab7363c106..ab7363c106 100644 --- a/lib/test_server/src/ts_erl_config.erl +++ b/lib/common_test/test_server/ts_erl_config.erl diff --git a/lib/test_server/src/ts_install.erl b/lib/common_test/test_server/ts_install.erl index 600a576820..600a576820 100644 --- a/lib/test_server/src/ts_install.erl +++ b/lib/common_test/test_server/ts_install.erl diff --git a/lib/test_server/src/ts_install_cth.erl b/lib/common_test/test_server/ts_install_cth.erl index ec0d54ccde..ec0d54ccde 100644 --- a/lib/test_server/src/ts_install_cth.erl +++ b/lib/common_test/test_server/ts_install_cth.erl diff --git a/lib/test_server/src/ts_lib.erl b/lib/common_test/test_server/ts_lib.erl index 7c3f450194..7c3f450194 100644 --- a/lib/test_server/src/ts_lib.erl +++ b/lib/common_test/test_server/ts_lib.erl diff --git a/lib/test_server/src/ts_make.erl b/lib/common_test/test_server/ts_make.erl index 0178f4d836..921edb264a 100644 --- a/lib/test_server/src/ts_make.erl +++ b/lib/common_test/test_server/ts_make.erl @@ -21,7 +21,7 @@ -export([make/1,make/3,unmake/1]). --include("test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Functions to be called from make test cases. diff --git a/lib/test_server/src/ts_run.erl b/lib/common_test/test_server/ts_run.erl index 188094921d..188094921d 100644 --- a/lib/test_server/src/ts_run.erl +++ b/lib/common_test/test_server/ts_run.erl diff --git a/lib/common_test/vsn.mk b/lib/common_test/vsn.mk index f33b705dcb..34ed657e01 100644 --- a/lib/common_test/vsn.mk +++ b/lib/common_test/vsn.mk @@ -1 +1 @@ -COMMON_TEST_VSN = 1.11.1 +COMMON_TEST_VSN = 1.11.2 diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile index 299b2892fc..f75beaba20 100644 --- a/lib/compiler/src/Makefile +++ b/lib/compiler/src/Makefile @@ -50,6 +50,7 @@ MODULES = \ beam_asm \ beam_block \ beam_bool \ + beam_bs \ beam_bsm \ beam_clean \ beam_dead \ @@ -62,6 +63,7 @@ MODULES = \ beam_opcodes \ beam_peep \ beam_receive \ + beam_reorder \ beam_split \ beam_trim \ beam_type \ diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl index a3201b0f4a..95be471de3 100644 --- a/lib/compiler/src/beam_asm.erl +++ b/lib/compiler/src/beam_asm.erl @@ -30,11 +30,12 @@ module(Code, Abst, SourceFile, Opts) -> {ok,assemble(Code, Abst, SourceFile, Opts)}. -assemble({Mod,Exp,Attr0,Asm0,NumLabels}, Abst, SourceFile, Opts) -> +assemble({Mod,Exp0,Attr0,Asm0,NumLabels}, Abst, SourceFile, Opts) -> {1,Dict0} = beam_dict:atom(Mod, beam_dict:new()), {0,Dict1} = beam_dict:fname(atom_to_list(Mod) ++ ".erl", Dict0), 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, Abst, SourceFile, Opts). @@ -61,7 +62,7 @@ insert_on_load_instruction(Is0, Entry) -> Bef ++ [El,on_load|Is]. assemble_1([{function,Name,Arity,Entry,Asm}|T], Exp, Dict0, Acc) -> - Dict1 = case member({Name,Arity}, Exp) of + Dict1 = case cerl_sets:is_element({Name,Arity}, Exp) of true -> beam_dict:export(Name, Arity, Entry, Dict0); false -> diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index 0321b1c07b..10dbaf462c 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -23,14 +23,13 @@ -module(beam_block). -export([module/2]). --import(lists, [mapfoldl/3,reverse/1,reverse/2,foldl/3,member/2]). --define(MAXREG, 1024). +-import(lists, [reverse/1,reverse/2,foldl/3,member/2]). -module({Mod,Exp,Attr,Fs0,Lc0}, _Opt) -> - {Fs,Lc} = mapfoldl(fun function/2, Lc0, Fs0), +module({Mod,Exp,Attr,Fs0,Lc}, _Opt) -> + Fs = [function(F) || F <- Fs0], {ok,{Mod,Exp,Attr,Fs,Lc}}. -function({function,Name,Arity,CLabel,Is0}, Lc0) -> +function({function,Name,Arity,CLabel,Is0}) -> try %% Collect basic blocks and optimize them. Is1 = blockify(Is0), @@ -40,11 +39,8 @@ function({function,Name,Arity,CLabel,Is0}, Lc0) -> Is5 = opt_blocks(Is4), Is6 = beam_utils:delete_live_annos(Is5), - %% Optimize bit syntax. - {Is,Lc} = bsm_opt(Is6, Lc0), - %% Done. - {{function,Name,Arity,CLabel,Is},Lc} + {function,Name,Arity,CLabel,Is6} catch Class:Error -> Stack = erlang:get_stacktrace(), @@ -62,56 +58,15 @@ blockify(Is) -> blockify([{loop_rec,{f,Fail},{x,0}},{loop_rec_end,_Lbl},{label,Fail}|Is], Acc) -> %% Useless instruction sequence. blockify(Is, Acc); -blockify([{test,is_atom,{f,Fail},[Reg]}=I| - [{select,select_val,Reg,{f,Fail}, - [{atom,false},{f,_}=BrFalse, - {atom,true}=AtomTrue,{f,_}=BrTrue]}|Is]=Is0], - [{block,Bl}|_]=Acc) -> - case is_last_bool(Bl, Reg) of - false -> - blockify(Is0, [I|Acc]); - true -> - %% The last instruction is a boolean operator/guard BIF that can't fail. - %% We can convert the three-way branch to a two-way branch (eliminating - %% the reference to the failure label). - blockify(Is, [{jump,BrTrue}, - {test,is_eq_exact,BrFalse,[Reg,AtomTrue]}|Acc]) - end; -blockify([{test,is_atom,{f,Fail},[Reg]}=I| - [{select,select_val,Reg,{f,Fail}, - [{atom,true}=AtomTrue,{f,_}=BrTrue, - {atom,false},{f,_}=BrFalse]}|Is]=Is0], - [{block,Bl}|_]=Acc) -> - case is_last_bool(Bl, Reg) of - false -> - blockify(Is0, [I|Acc]); - true -> - blockify(Is, [{jump,BrTrue}, - {test,is_eq_exact,BrFalse,[Reg,AtomTrue]}|Acc]) - end; blockify([I|Is0]=IsAll, Acc) -> - case is_bs_put(I) of - true -> - {BsPuts0,Is} = collect_bs_puts(IsAll), - BsPuts = opt_bs_puts(BsPuts0), - blockify(Is, reverse(BsPuts, Acc)); - false -> - case collect(I) of - error -> blockify(Is0, [I|Acc]); - Instr when is_tuple(Instr) -> - {Block,Is} = collect_block(IsAll), - blockify(Is, [{block,Block}|Acc]) - end + case collect(I) of + error -> blockify(Is0, [I|Acc]); + Instr when is_tuple(Instr) -> + {Block,Is} = collect_block(IsAll), + blockify(Is, [{block,Block}|Acc]) end; blockify([], Acc) -> reverse(Acc). -is_last_bool([{set,[Reg],As,{bif,N,_}}], Reg) -> - Ar = length(As), - erl_internal:new_type_test(N, Ar) orelse erl_internal:comp_op(N, Ar) - orelse erl_internal:bool_op(N, Ar); -is_last_bool([_|Is], Reg) -> is_last_bool(Is, Reg); -is_last_bool([], _) -> false. - collect_block(Is) -> collect_block(Is, []). @@ -149,7 +104,10 @@ collect({put_map,F,Op,S,D,R,{list,Puts}}) -> collect({get_map_elements,F,S,{list,Gets}}) -> {Ss,Ds} = beam_utils:split_even(Gets), {set,Ds,[S|Ss],{get_map_elements,F}}; -collect({'catch',R,L}) -> {set,[R],[],{'catch',L}}; +collect({'catch'=Op,R,L}) -> + {set,[R],[],{try_catch,Op,L}}; +collect({'try'=Op,R,L}) -> + {set,[R],[],{try_catch,Op,L}}; collect(fclearerror) -> {set,[],[],fclearerror}; collect({fcheckerror,{f,0}}) -> {set,[],[],fcheckerror}; collect({fmove,S,D}) -> {set,[D],[S],fmove}; @@ -183,7 +141,9 @@ opt_blocks([I|Is]) -> opt_blocks([]) -> []. opt_block(Is0) -> - Is = find_fixpoint(fun opt/1, Is0), + Is = find_fixpoint(fun(Is) -> + opt_tuple_element(opt(Is)) + end, Is0), opt_alloc(Is). find_fixpoint(OptFun, Is0) -> @@ -279,76 +239,151 @@ opt_moves([X0,Y0], Is0) -> not_possible -> {[X,Y0],Is2}; {X,_} -> {[X,Y0],Is2}; {Y,Is} -> {[X,Y],Is} - end; -opt_moves(Ds, Is) -> - %% multiple destinations -> pass through - {Ds,Is}. - + end. %% opt_move(Dest, [Instruction]) -> {UpdatedDest,[Instruction]} | not_possible %% If there is a {move,Dest,FinalDest} instruction %% in the instruction stream, remove the move instruction %% and let FinalDest be the destination. -%% -%% For this optimization to be safe, we must be sure that -%% Dest will not be referenced in any other by other instructions -%% in the rest of the instruction stream. Not even the indirect -%% reference by an instruction that may allocate (such as -%% test_heap/2 or a GC Bif) is allowed. opt_move(Dest, Is) -> - opt_move_1(Dest, Is, ?MAXREG, []). - -opt_move_1(R, [{set,_,_,{alloc,Live,_}}|_]=Is, SafeRegs, Acc) when Live < SafeRegs -> - %% Downgrade number of safe regs and rescan the instruction, as it most probably - %% is a gc_bif instruction. - opt_move_1(R, Is, Live, Acc); -opt_move_1(R, [{set,[{x,X}=D],[R],move}|Is], SafeRegs, Acc) -> - case X < SafeRegs andalso beam_utils:is_killed_block(R, Is) of - true -> opt_move_2(D, Acc, Is); - false -> not_possible + opt_move_1(Dest, Is, []). + +opt_move_1(R, [{set,[D],[R],move}|Is0], Acc) -> + %% Provided that the source register is killed by instructions + %% that follow, the optimization is safe. + case eliminate_use_of_from_reg(Is0, R, D, []) of + {yes,Is} -> opt_move_rev(D, Acc, Is); + no -> not_possible end; -opt_move_1(R, [{set,[D],[R],move}|Is], _SafeRegs, Acc) -> - case beam_utils:is_killed_block(R, Is) of - true -> opt_move_2(D, Acc, Is); - false -> not_possible +opt_move_1({x,_}, [{set,_,_,{alloc,_,_}}|_], _) -> + %% The optimization is not possible. If the X register is not + %% killed by allocation, the optimization would not be safe. + %% If the X register is killed, it means that there cannot + %% follow a 'move' instruction with this X register as the + %% source. + not_possible; +opt_move_1(R, [{set,_,_,_}=I|Is], Acc) -> + %% If the source register is either killed or used by this + %% instruction, the optimimization is not possible. + case is_killed_or_used(R, I) of + true -> not_possible; + false -> opt_move_1(R, Is, [I|Acc]) end; -opt_move_1(R, [I|Is], SafeRegs, Acc) -> - case is_transparent(R, I) of - false -> not_possible; - true -> opt_move_1(R, Is, SafeRegs, [I|Acc]) - end. +opt_move_1(_, _, _) -> + not_possible. + +%% opt_tuple_element([Instruction]) -> [Instruction] +%% If possible, move get_tuple_element instructions forward +%% in the instruction stream to a move instruction, eliminating +%% the move instruction. Example: +%% +%% get_tuple_element Tuple Pos Dst1 +%% ... +%% move Dst1 Dst2 +%% +%% This code may be possible to rewrite to: +%% +%% %%(Moved get_tuple_element instruction) +%% ... +%% get_tuple_element Tuple Pos Dst2 +%% -%% Reverse the instructions, while checking that there are no instructions that -%% would interfere with using the new destination register chosen. +opt_tuple_element([{set,[D],[S],{get_tuple_element,_}}=I|Is0]) -> + case opt_tuple_element_1(Is0, I, {S,D}, []) of + no -> + [I|opt_tuple_element(Is0)]; + {yes,Is} -> + opt_tuple_element(Is) + end; +opt_tuple_element([I|Is]) -> + [I|opt_tuple_element(Is)]; +opt_tuple_element([]) -> []. + +opt_tuple_element_1([{set,_,_,{alloc,_,_}}|_], _, _, _) -> + no; +opt_tuple_element_1([{set,_,_,{try_catch,_,_}}|_], _, _, _) -> + no; +opt_tuple_element_1([{set,[D],[S],move}|Is0], I0, {_,S}, Acc) -> + case eliminate_use_of_from_reg(Is0, S, D, []) of + no -> + no; + {yes,Is} -> + {set,[S],Ss,Op} = I0, + I = {set,[D],Ss,Op}, + {yes,reverse(Acc, [I|Is])} + end; +opt_tuple_element_1([{set,Ds,Ss,_}=I|Is], MovedI, {S,D}=Regs, Acc) -> + case member(S, Ds) orelse member(D, Ss) of + true -> + no; + false -> + opt_tuple_element_1(Is, MovedI, Regs, [I|Acc]) + end; +opt_tuple_element_1(_, _, _, _) -> no. + +%% Reverse the instructions, while checking that there are no +%% instructions that would interfere with using the new destination +%% register (D). -opt_move_2(D, [I|Is], Acc) -> - case is_transparent(D, I) of - false -> not_possible; - true -> opt_move_2(D, Is, [I|Acc]) +opt_move_rev(D, [I|Is], Acc) -> + case is_killed_or_used(D, I) of + true -> not_possible; + false -> opt_move_rev(D, Is, [I|Acc]) + end; +opt_move_rev(D, [], Acc) -> {D,Acc}. + +%% is_killed_or_used(Register, {set,_,_,_}) -> bool() +%% Test whether the register is used by the instruction. + +is_killed_or_used(R, {set,Ss,Ds,_}) -> + member(R, Ds) orelse member(R, Ss). + +%% eliminate_use_of_from_reg([Instruction], FromRegister, ToRegister, Acc) -> +%% {yes,Is} | no +%% Eliminate any use of FromRegister in the instruction sequence +%% by replacing uses of FromRegister with ToRegister. If FromRegister +%% is referenced by an allocation instruction, return 'no' to indicate +%% that FromRegister is still used and that the optimization is not +%% possible. + +eliminate_use_of_from_reg([{set,_,_,{alloc,Live,_}}|_]=Is0, {x,X}, _, Acc) -> + if + X < Live -> + no; + true -> + {yes,reverse(Acc, Is0)} end; -opt_move_2(D, [], Acc) -> {D,Acc}. - -%% is_transparent(Register, Instruction) -> true | false -%% Returns true if Instruction does not in any way references Register -%% (even indirectly by an allocation instruction). -%% Returns false if Instruction does reference Register, or we are -%% not sure. - -is_transparent({x,X}, {set,_,_,{alloc,Live,_}}) when X < Live -> - false; -is_transparent(R, {set,Ds,Ss,_Op}) -> - case member(R, Ds) of - true -> false; - false -> not member(R, Ss) +eliminate_use_of_from_reg([{set,Ds,Ss0,Op}=I0|Is], From, To, Acc) -> + I = case member(From, Ss0) of + true -> + Ss = [case S of + From -> To; + _ -> S + end || S <- Ss0], + {set,Ds,Ss,Op}; + false -> + I0 + end, + case member(From, Ds) of + true -> + {yes,reverse(Acc, [I|Is])}; + false -> + eliminate_use_of_from_reg(Is, From, To, [I|Acc]) end; -is_transparent(_, _) -> false. +eliminate_use_of_from_reg([I]=Is, From, _To, Acc) -> + case beam_utils:is_killed_block(From, [I]) of + true -> + {yes,reverse(Acc, Is)}; + false -> + no + end. %% opt_alloc(Instructions) -> Instructions' %% Optimises all allocate instructions. opt_alloc([{set,[],[],{alloc,R,{_,Ns,Nh,[]}}}|Is]) -> - [{set,[],[],opt_alloc(Is, Ns, Nh, R)}|opt(Is)]; + [{set,[],[],opt_alloc(Is, Ns, Nh, R)}|Is]; opt_alloc([I|Is]) -> [I|opt_alloc(Is)]; opt_alloc([]) -> []. @@ -414,234 +449,3 @@ x_dead([], Regs) -> Regs. x_live([{x,N}|Rs], Regs) -> x_live(Rs, Regs bor (1 bsl N)); x_live([_|Rs], Regs) -> x_live(Rs, Regs); x_live([], Regs) -> Regs. - -%%% -%%% Evaluation of constant bit fields. -%%% - -is_bs_put({bs_put,_,{bs_put_integer,_,_},_}) -> true; -is_bs_put({bs_put,_,{bs_put_float,_,_},_}) -> true; -is_bs_put(_) -> false. - -collect_bs_puts(Is) -> - collect_bs_puts_1(Is, []). - -collect_bs_puts_1([I|Is]=Is0, Acc) -> - case is_bs_put(I) of - false -> {reverse(Acc),Is0}; - true -> collect_bs_puts_1(Is, [I|Acc]) - end. - -opt_bs_puts(Is) -> - opt_bs_1(Is, []). - -opt_bs_1([{bs_put,Fail, - {bs_put_float,1,Flags0},[{integer,Sz},Src]}=I0|Is], Acc) -> - try eval_put_float(Src, Sz, Flags0) of - <<Int:Sz>> -> - Flags = force_big(Flags0), - I = {bs_put,Fail,{bs_put_integer,1,Flags}, - [{integer,Sz},{integer,Int}]}, - opt_bs_1([I|Is], Acc) - catch - error:_ -> - opt_bs_1(Is, [I0|Acc]) - end; -opt_bs_1([{bs_put,_,{bs_put_integer,1,_},[{integer,8},{integer,_}]}|_]=IsAll, - Acc0) -> - {Is,Acc} = bs_collect_string(IsAll, Acc0), - opt_bs_1(Is, Acc); -opt_bs_1([{bs_put,Fail,{bs_put_integer,1,F},[{integer,Sz},{integer,N}]}=I|Is0], - Acc) when Sz > 8 -> - case field_endian(F) of - big -> - %% We can do this optimization for any field size without risk - %% for code explosion. - case bs_split_int(N, Sz, Fail, Is0) of - no_split -> opt_bs_1(Is0, [I|Acc]); - Is -> opt_bs_1(Is, Acc) - end; - little when Sz < 128 -> - %% We only try to optimize relatively small fields, to avoid - %% an explosion in code size. - <<Int:Sz>> = <<N:Sz/little>>, - Flags = force_big(F), - Is = [{bs_put,Fail,{bs_put_integer,1,Flags}, - [{integer,Sz},{integer,Int}]}|Is0], - opt_bs_1(Is, Acc); - _ -> %native or too wide little field - opt_bs_1(Is0, [I|Acc]) - end; -opt_bs_1([{bs_put,Fail,{Op,U,F},[{integer,Sz},Src]}|Is], Acc) when U > 1 -> - opt_bs_1([{bs_put,Fail,{Op,1,F},[{integer,U*Sz},Src]}|Is], Acc); -opt_bs_1([I|Is], Acc) -> - opt_bs_1(Is, [I|Acc]); -opt_bs_1([], Acc) -> reverse(Acc). - -eval_put_float(Src, Sz, Flags) when Sz =< 256 -> %Only evaluate if Sz is reasonable. - Val = value(Src), - case field_endian(Flags) of - little -> <<Val:Sz/little-float-unit:1>>; - big -> <<Val:Sz/big-float-unit:1>> - %% native intentionally not handled here - we can't optimize it. - end. - -value({integer,I}) -> I; -value({float,F}) -> F. - -bs_collect_string(Is, [{bs_put,_,{bs_put_string,Len,{string,Str}},[]}|Acc]) -> - bs_coll_str_1(Is, Len, reverse(Str), Acc); -bs_collect_string(Is, Acc) -> - bs_coll_str_1(Is, 0, [], Acc). - -bs_coll_str_1([{bs_put,_,{bs_put_integer,U,_},[{integer,Sz},{integer,V}]}|Is], - Len, StrAcc, IsAcc) when U*Sz =:= 8 -> - Byte = V band 16#FF, - bs_coll_str_1(Is, Len+1, [Byte|StrAcc], IsAcc); -bs_coll_str_1(Is, Len, StrAcc, IsAcc) -> - {Is,[{bs_put,{f,0},{bs_put_string,Len,{string,reverse(StrAcc)}},[]}|IsAcc]}. - -field_endian({field_flags,F}) -> field_endian_1(F). - -field_endian_1([big=E|_]) -> E; -field_endian_1([little=E|_]) -> E; -field_endian_1([native=E|_]) -> E; -field_endian_1([_|Fs]) -> field_endian_1(Fs). - -force_big({field_flags,F}) -> - {field_flags,force_big_1(F)}. - -force_big_1([big|_]=Fs) -> Fs; -force_big_1([little|Fs]) -> [big|Fs]; -force_big_1([F|Fs]) -> [F|force_big_1(Fs)]. - -bs_split_int(0, Sz, _, _) when Sz > 64 -> - %% We don't want to split in this case because the - %% string will consist of only zeroes. - no_split; -bs_split_int(-1, Sz, _, _) when Sz > 64 -> - %% We don't want to split in this case because the - %% string will consist of only 255 bytes. - no_split; -bs_split_int(N, Sz, Fail, Acc) -> - FirstByteSz = case Sz rem 8 of - 0 -> 8; - Rem -> Rem - end, - bs_split_int_1(N, FirstByteSz, Sz, Fail, Acc). - -bs_split_int_1(-1, _, Sz, Fail, Acc) when Sz > 64 -> - I = {bs_put,Fail,{bs_put_integer,1,{field_flags,[big]}}, - [{integer,Sz},{integer,-1}]}, - [I|Acc]; -bs_split_int_1(0, _, Sz, Fail, Acc) when Sz > 64 -> - I = {bs_put,Fail,{bs_put_integer,1,{field_flags,[big]}}, - [{integer,Sz},{integer,0}]}, - [I|Acc]; -bs_split_int_1(N, ByteSz, Sz, Fail, Acc) when Sz > 0 -> - Mask = (1 bsl ByteSz) - 1, - I = {bs_put,Fail,{bs_put_integer,1,{field_flags,[big]}}, - [{integer,ByteSz},{integer,N band Mask}]}, - bs_split_int_1(N bsr ByteSz, 8, Sz-ByteSz, Fail, [I|Acc]); -bs_split_int_1(_, _, _, _, Acc) -> Acc. - - -%%% -%%% Optimization of new bit syntax matching: get rid -%%% of redundant bs_restore2/2 instructions across select_val -%%% instructions, as well as a few other simple peep-hole optimizations. -%%% - -bsm_opt(Is0, Lc0) -> - {Is1,D0,Lc} = bsm_scan(Is0, [], Lc0, []), - Is2 = case D0 of - [] -> - Is1; - _ -> - D = gb_trees:from_orddict(orddict:from_list(D0)), - bsm_reroute(Is1, D, none, []) - end, - Is = beam_clean:bs_clean_saves(Is2), - {bsm_opt_2(Is, []),Lc}. - -bsm_scan([{label,L}=Lbl,{bs_restore2,_,Save}=R|Is], D0, Lc, Acc0) -> - D = [{{L,Save},Lc}|D0], - Acc = [{label,Lc},R,Lbl|Acc0], - bsm_scan(Is, D, Lc+1, Acc); -bsm_scan([I|Is], D, Lc, Acc) -> - bsm_scan(Is, D, Lc, [I|Acc]); -bsm_scan([], D, Lc, Acc) -> - {reverse(Acc),D,Lc}. - -bsm_reroute([{bs_save2,Reg,Save}=I|Is], D, _, Acc) -> - bsm_reroute(Is, D, {Reg,Save}, [I|Acc]); -bsm_reroute([{bs_restore2,Reg,Save}=I|Is], D, _, Acc) -> - bsm_reroute(Is, D, {Reg,Save}, [I|Acc]); -bsm_reroute([{label,_}=I|Is], D, S, Acc) -> - bsm_reroute(Is, D, S, [I|Acc]); -bsm_reroute([{select,select_val,Reg,F0,Lbls0}|Is], D, {_,Save}=S, Acc0) -> - [F|Lbls] = bsm_subst_labels([F0|Lbls0], Save, D), - Acc = [{select,select_val,Reg,F,Lbls}|Acc0], - bsm_reroute(Is, D, S, Acc); -bsm_reroute([{test,TestOp,F0,TestArgs}=I|Is], D, {_,Save}=S, Acc0) -> - F = bsm_subst_label(F0, Save, D), - Acc = [{test,TestOp,F,TestArgs}|Acc0], - case bsm_not_bs_test(I) of - true -> - %% The test instruction will not update the bit offset for the - %% binary being matched. Therefore the save position can be kept. - bsm_reroute(Is, D, S, Acc); - false -> - %% The test instruction might update the bit offset. Kill our - %% remembered Save position. - bsm_reroute(Is, D, none, Acc) - end; -bsm_reroute([{test,TestOp,F0,Live,TestArgs,Dst}|Is], D, {_,Save}, Acc0) -> - F = bsm_subst_label(F0, Save, D), - Acc = [{test,TestOp,F,Live,TestArgs,Dst}|Acc0], - %% The test instruction will update the bit offset. Kill our - %% remembered Save position. - bsm_reroute(Is, D, none, Acc); -bsm_reroute([{block,[{set,[],[],{alloc,_,_}}]}=Bl, - {bs_context_to_binary,_}=I|Is], D, S, Acc) -> - %% To help further bit syntax optimizations. - bsm_reroute([I,Bl|Is], D, S, Acc); -bsm_reroute([I|Is], D, _, Acc) -> - bsm_reroute(Is, D, none, [I|Acc]); -bsm_reroute([], _, _, Acc) -> reverse(Acc). - -bsm_opt_2([{test,bs_test_tail2,F,[Ctx,Bits]}|Is], - [{test,bs_skip_bits2,F,[Ctx,{integer,I},Unit,_Flags]}|Acc]) -> - bsm_opt_2(Is, [{test,bs_test_tail2,F,[Ctx,Bits+I*Unit]}|Acc]); -bsm_opt_2([{test,bs_skip_bits2,F,[Ctx,{integer,I1},Unit1,_]}|Is], - [{test,bs_skip_bits2,F,[Ctx,{integer,I2},Unit2,Flags]}|Acc]) -> - bsm_opt_2(Is, [{test,bs_skip_bits2,F, - [Ctx,{integer,I1*Unit1+I2*Unit2},1,Flags]}|Acc]); -bsm_opt_2([I|Is], Acc) -> - bsm_opt_2(Is, [I|Acc]); -bsm_opt_2([], Acc) -> reverse(Acc). - -%% bsm_not_bs_test({test,Name,_,Operands}) -> true|false. -%% Test whether is the test is a "safe", i.e. does not move the -%% bit offset for a binary. -%% -%% 'true' means that the test is safe, 'false' that we don't know or -%% that the test moves the offset (e.g. bs_get_integer2). - -bsm_not_bs_test({test,bs_test_tail2,_,[_,_]}) -> true; -bsm_not_bs_test(Test) -> beam_utils:is_pure_test(Test). - -bsm_subst_labels(Fs, Save, D) -> - bsm_subst_labels_1(Fs, Save, D, []). - -bsm_subst_labels_1([F|Fs], Save, D, Acc) -> - bsm_subst_labels_1(Fs, Save, D, [bsm_subst_label(F, Save, D)|Acc]); -bsm_subst_labels_1([], _, _, Acc) -> - reverse(Acc). - -bsm_subst_label({f,Lbl0}=F, Save, D) -> - case gb_trees:lookup({Lbl0,Save}, D) of - {value,Lbl} -> {f,Lbl}; - none -> F - end; -bsm_subst_label(Other, _, _) -> Other. diff --git a/lib/compiler/src/beam_bool.erl b/lib/compiler/src/beam_bool.erl index 14b6381230..efd935f666 100644 --- a/lib/compiler/src/beam_bool.erl +++ b/lib/compiler/src/beam_bool.erl @@ -25,8 +25,6 @@ -import(lists, [reverse/1,reverse/2,foldl/3,mapfoldl/3,map/2]). --define(MAXREG, 1024). - -record(st, {next, %Next label number. ll %Live regs at labels. @@ -142,11 +140,6 @@ bopt_block(Reg, Fail, OldIs, [{block,Bl0}|Acc0], St0) -> throw:not_boolean_expr -> failed; - %% The block contains a 'move' instruction that could - %% not be handled. - throw:move -> - failed; - %% The optimization is not safe. (A register %% used by the instructions following the %% optimized code is either not assigned a @@ -215,37 +208,14 @@ ensure_opt_safe(Bl, NewCode, OldIs, Fail, PrecedingCode, St) -> false -> throw(all_registers_not_killed); true -> ok end, - Same = assigned_same_value(Bl, NewCode), MustBeUnused = ordsets:subtract(ordsets:union(NotSet, NewDst), - ordsets:union(MustBeKilled, Same)), + MustBeKilled), case none_used(MustBeUnused, OldIs, Fail, St) of false -> throw(registers_used); true -> ok end, ok. -%% assigned_same_value(OldCode, NewCodeReversed) -> [DestinationRegs] -%% Return an ordset with a list of all y registers that are always -%% assigned the same value in the old and new code. Currently, we -%% are very conservative in that we only consider identical move -%% instructions in the same order. -%% -assigned_same_value(Old, New) -> - case reverse(New) of - [{block,Bl}|_] -> - assigned_same_value(Old, Bl, []); - _ -> - ordsets:new() - end. - -assigned_same_value([{set,[{y,_}=D],[S],move}|T1], - [{set,[{y,_}=D],[S],move}|T2], Acc) -> - assigned_same_value(T1, T2, [D|Acc]); -assigned_same_value(_, _, Acc) -> - ordsets:from_list(Acc). - -update_fail_label([{set,_,_,move}=I|Is], Fail, Acc) -> - update_fail_label(Is, Fail, [I|Acc]); update_fail_label([{set,Ds,As,{bif,N,{f,_}}}|Is], Fail, Acc) -> update_fail_label(Is, Fail, [{set,Ds,As,{bif,N,{f,Fail}}}|Acc]); update_fail_label([{set,Ds,As,{alloc,Regs,{gc_bif,N,{f,_}}}}|Is], Fail, Acc) -> @@ -314,8 +284,6 @@ split_block_1(Is, Fail, ProhibitFailLabel) -> end end. -split_block_2([{set,_,_,move}=I|Is], Fail, Acc) -> - split_block_2(Is, Fail, [I|Acc]); split_block_2([{set,[_],_,{bif,_,{f,Fail}}}=I|Is], Fail, Acc) -> split_block_2(Is, Fail, [I|Acc]); split_block_2([{set,[_],_,{alloc,_,{gc_bif,_,{f,Fail}}}}=I|Is], Fail, Acc) -> @@ -343,8 +311,6 @@ dst_regs([{set,[D],_,{bif,_,{f,_}}}|Is], Acc) -> dst_regs(Is, [D|Acc]); dst_regs([{set,[D],_,{alloc,_,{gc_bif,_,{f,_}}}}|Is], Acc) -> dst_regs(Is, [D|Acc]); -dst_regs([{set,[D],_,move}|Is], Acc) -> - dst_regs(Is, [D|Acc]); dst_regs([_|Is], Acc) -> dst_regs(Is, Acc); dst_regs([], Acc) -> ordsets:from_list(Acc). @@ -411,13 +377,6 @@ bopt_tree([{protected,[Dst],Code,_}|Is], Forest0, Pre) -> _Res -> throw(not_boolean_expr) end; -bopt_tree([{set,[Dst],[Src],move}=Move|Is], Forest, Pre) -> - case {Src,Dst} of - {{tmp,_},_} -> throw(move); - {_,{tmp,_}} -> throw(move); - _ -> ok - end, - bopt_tree(Is, Forest, [Move|Pre]); bopt_tree([{set,[Dst],As,{bif,N,_}}=Bif|Is], Forest0, Pre) -> Ar = length(As), case safe_bool_op(N, Ar) of @@ -589,10 +548,6 @@ free_variables(Is) -> E = gb_sets:empty(), free_vars_1(Is, E, E, E). -free_vars_1([{set,Ds,As,move}|Is], F0, N0, A) -> - F = gb_sets:union(F0, gb_sets:difference(var_list(As), N0)), - N = gb_sets:union(N0, var_list(Ds)), - free_vars_1(Is, F, N, A); free_vars_1([{set,Ds,As,{bif,_,_}}|Is], F0, N0, A) -> F = gb_sets:union(F0, gb_sets:difference(var_list(As), N0)), N = gb_sets:union(N0, var_list(Ds)), @@ -632,8 +587,6 @@ free_vars_regs(X) -> [{x,X-1}|free_vars_regs(X-1)]. rename_regs(Is, Regs) -> rename_regs(Is, Regs, []). -rename_regs([{set,_,_,move}=I|Is], Regs, Acc) -> - rename_regs(Is, Regs, [I|Acc]); rename_regs([{set,[Dst0],Ss0,{alloc,_,Info}}|Is], Regs0, Acc) -> Live = live_regs(Regs0), Ss = rename_sources(Ss0, Regs0), @@ -737,8 +690,7 @@ ssa_assign({x,_}=R, #ssa{sub=Sub0}=Ssa0) -> Sub1 = gb_trees:update(R, NewReg, Sub0), Sub = gb_trees:insert(NewReg, NewReg, Sub1), Ssa#ssa{sub=Sub} - end; -ssa_assign(_, Ssa) -> Ssa. + end. ssa_sub_list(List, Sub) -> [ssa_sub(E, Sub) || E <- List]. diff --git a/lib/compiler/src/beam_bs.erl b/lib/compiler/src/beam_bs.erl new file mode 100644 index 0000000000..55fa7ce10c --- /dev/null +++ b/lib/compiler/src/beam_bs.erl @@ -0,0 +1,278 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2013. 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 : Partitions assembly instructions into basic blocks and +%% optimizes them. + +-module(beam_bs). + +-export([module/2]). +-import(lists, [mapfoldl/3,reverse/1]). + +module({Mod,Exp,Attr,Fs0,Lc0}, _Opt) -> + {Fs,Lc} = mapfoldl(fun function/2, Lc0, Fs0), + {ok,{Mod,Exp,Attr,Fs,Lc}}. + +function({function,Name,Arity,CLabel,Is0}, Lc0) -> + try + Is1 = bs_put_opt(Is0), + {Is,Lc} = bsm_opt(Is1, Lc0), + {{function,Name,Arity,CLabel,Is},Lc} + catch + Class:Error -> + Stack = erlang:get_stacktrace(), + io:fwrite("Function: ~w/~w\n", [Name,Arity]), + erlang:raise(Class, Error, Stack) + end. + +%%% +%%% Evaluation of constant bit fields. +%%% + +bs_put_opt([{bs_put,_,_,_}=I|Is0]) -> + {BsPuts0,Is} = collect_bs_puts(Is0, [I]), + BsPuts = opt_bs_puts(BsPuts0), + BsPuts ++ bs_put_opt(Is); +bs_put_opt([I|Is]) -> + [I|bs_put_opt(Is)]; +bs_put_opt([]) -> []. + +collect_bs_puts([{bs_put,_,_,_}=I|Is], Acc) -> + collect_bs_puts(Is, [I|Acc]); +collect_bs_puts([_|_]=Is, Acc) -> + {reverse(Acc),Is}. + +opt_bs_puts(Is) -> + opt_bs_1(Is, []). + +opt_bs_1([{bs_put,Fail, + {bs_put_float,1,Flags0},[{integer,Sz},Src]}=I0|Is], Acc) -> + try eval_put_float(Src, Sz, Flags0) of + <<Int:Sz>> -> + Flags = force_big(Flags0), + I = {bs_put,Fail,{bs_put_integer,1,Flags}, + [{integer,Sz},{integer,Int}]}, + opt_bs_1([I|Is], Acc) + catch + error:_ -> + opt_bs_1(Is, [I0|Acc]) + end; +opt_bs_1([{bs_put,_,{bs_put_integer,1,_},[{integer,8},{integer,_}]}|_]=IsAll, + Acc0) -> + {Is,Acc} = bs_collect_string(IsAll, Acc0), + opt_bs_1(Is, Acc); +opt_bs_1([{bs_put,Fail,{bs_put_integer,1,F},[{integer,Sz},{integer,N}]}=I|Is0], + Acc) when Sz > 8 -> + case field_endian(F) of + big -> + %% We can do this optimization for any field size without + %% risk for code explosion. + case bs_split_int(N, Sz, Fail, Is0) of + no_split -> opt_bs_1(Is0, [I|Acc]); + Is -> opt_bs_1(Is, Acc) + end; + little when Sz < 128 -> + %% We only try to optimize relatively small fields, to + %% avoid an explosion in code size. + <<Int:Sz>> = <<N:Sz/little>>, + Flags = force_big(F), + Is = [{bs_put,Fail,{bs_put_integer,1,Flags}, + [{integer,Sz},{integer,Int}]}|Is0], + opt_bs_1(Is, Acc); + _ -> %native or too wide little field + opt_bs_1(Is0, [I|Acc]) + end; +opt_bs_1([{bs_put,Fail,{Op,U,F},[{integer,Sz},Src]}|Is], Acc) when U > 1 -> + opt_bs_1([{bs_put,Fail,{Op,1,F},[{integer,U*Sz},Src]}|Is], Acc); +opt_bs_1([I|Is], Acc) -> + opt_bs_1(Is, [I|Acc]); +opt_bs_1([], Acc) -> reverse(Acc). + +eval_put_float(Src, Sz, Flags) when Sz =< 256 -> + %%Only evaluate if Sz is reasonable. + Val = value(Src), + case field_endian(Flags) of + little -> <<Val:Sz/little-float-unit:1>>; + big -> <<Val:Sz/big-float-unit:1>> + %% native intentionally not handled here - we can't optimize + %% it. + end. + +value({integer,I}) -> I; +value({float,F}) -> F. + +bs_collect_string(Is, [{bs_put,_,{bs_put_string,Len,{string,Str}},[]}|Acc]) -> + bs_coll_str_1(Is, Len, reverse(Str), Acc); +bs_collect_string(Is, Acc) -> + bs_coll_str_1(Is, 0, [], Acc). + +bs_coll_str_1([{bs_put,_,{bs_put_integer,U,_},[{integer,Sz},{integer,V}]}|Is], + Len, StrAcc, IsAcc) when U*Sz =:= 8 -> + Byte = V band 16#FF, + bs_coll_str_1(Is, Len+1, [Byte|StrAcc], IsAcc); +bs_coll_str_1(Is, Len, StrAcc, IsAcc) -> + {Is,[{bs_put,{f,0},{bs_put_string,Len,{string,reverse(StrAcc)}},[]}|IsAcc]}. + +field_endian({field_flags,F}) -> field_endian_1(F). + +field_endian_1([big=E|_]) -> E; +field_endian_1([little=E|_]) -> E; +field_endian_1([native=E|_]) -> E; +field_endian_1([_|Fs]) -> field_endian_1(Fs). + +force_big({field_flags,F}) -> + {field_flags,force_big_1(F)}. + +force_big_1([big|_]=Fs) -> Fs; +force_big_1([little|Fs]) -> [big|Fs]; +force_big_1([F|Fs]) -> [F|force_big_1(Fs)]. + +bs_split_int(0, Sz, _, _) when Sz > 64 -> + %% We don't want to split in this case because the + %% string will consist of only zeroes. + no_split; +bs_split_int(-1, Sz, _, _) when Sz > 64 -> + %% We don't want to split in this case because the + %% string will consist of only 255 bytes. + no_split; +bs_split_int(N, Sz, Fail, Acc) -> + FirstByteSz = case Sz rem 8 of + 0 -> 8; + Rem -> Rem + end, + bs_split_int_1(N, FirstByteSz, Sz, Fail, Acc). + +bs_split_int_1(-1, _, Sz, Fail, Acc) when Sz > 64 -> + I = {bs_put,Fail,{bs_put_integer,1,{field_flags,[big]}}, + [{integer,Sz},{integer,-1}]}, + [I|Acc]; +bs_split_int_1(0, _, Sz, Fail, Acc) when Sz > 64 -> + I = {bs_put,Fail,{bs_put_integer,1,{field_flags,[big]}}, + [{integer,Sz},{integer,0}]}, + [I|Acc]; +bs_split_int_1(N, ByteSz, Sz, Fail, Acc) when Sz > 0 -> + Mask = (1 bsl ByteSz) - 1, + I = {bs_put,Fail,{bs_put_integer,1,{field_flags,[big]}}, + [{integer,ByteSz},{integer,N band Mask}]}, + bs_split_int_1(N bsr ByteSz, 8, Sz-ByteSz, Fail, [I|Acc]); +bs_split_int_1(_, _, _, _, Acc) -> Acc. + +%%% +%%% Optimization of bit syntax matching: get rid +%%% of redundant bs_restore2/2 instructions across select_val +%%% instructions, as well as a few other simple peep-hole +%%% optimizations. +%%% + +bsm_opt(Is0, Lc0) -> + {Is1,D0,Lc} = bsm_scan(Is0, [], Lc0, []), + Is2 = case D0 of + [] -> + %% No bit syntax matching in this function. + Is1; + [_|_] -> + %% Optimize the bit syntax matching. + D = gb_trees:from_orddict(orddict:from_list(D0)), + bsm_reroute(Is1, D, none, []) + end, + Is = beam_clean:bs_clean_saves(Is2), + {bsm_opt_2(Is, []),Lc}. + +bsm_scan([{label,L}=Lbl,{bs_restore2,_,Save}=R|Is], D0, Lc, Acc0) -> + D = [{{L,Save},Lc}|D0], + Acc = [{label,Lc},R,Lbl|Acc0], + bsm_scan(Is, D, Lc+1, Acc); +bsm_scan([I|Is], D, Lc, Acc) -> + bsm_scan(Is, D, Lc, [I|Acc]); +bsm_scan([], D, Lc, Acc) -> + {reverse(Acc),D,Lc}. + +bsm_reroute([{bs_save2,Reg,Save}=I|Is], D, _, Acc) -> + bsm_reroute(Is, D, {Reg,Save}, [I|Acc]); +bsm_reroute([{bs_restore2,Reg,Save}=I|Is], D, _, Acc) -> + bsm_reroute(Is, D, {Reg,Save}, [I|Acc]); +bsm_reroute([{label,_}=I|Is], D, S, Acc) -> + bsm_reroute(Is, D, S, [I|Acc]); +bsm_reroute([{select,select_val,Reg,F0,Lbls0}|Is], D, {_,Save}=S, Acc0) -> + [F|Lbls] = bsm_subst_labels([F0|Lbls0], Save, D), + Acc = [{select,select_val,Reg,F,Lbls}|Acc0], + bsm_reroute(Is, D, S, Acc); +bsm_reroute([{test,TestOp,F0,TestArgs}=I|Is], D, {_,Save}=S, Acc0) -> + F = bsm_subst_label(F0, Save, D), + Acc = [{test,TestOp,F,TestArgs}|Acc0], + case bsm_not_bs_test(I) of + true -> + %% The test instruction will not update the bit offset for + %% the binary being matched. Therefore the save position + %% can be kept. + bsm_reroute(Is, D, S, Acc); + false -> + %% The test instruction might update the bit offset. Kill + %% our remembered Save position. + bsm_reroute(Is, D, none, Acc) + end; +bsm_reroute([{test,TestOp,F0,Live,TestArgs,Dst}|Is], D, {_,Save}, Acc0) -> + F = bsm_subst_label(F0, Save, D), + Acc = [{test,TestOp,F,Live,TestArgs,Dst}|Acc0], + %% The test instruction will update the bit offset. Kill our + %% remembered Save position. + bsm_reroute(Is, D, none, Acc); +bsm_reroute([{block,[{set,[],[],{alloc,_,_}}]}=Bl, + {bs_context_to_binary,_}=I|Is], D, S, Acc) -> + %% To help further bit syntax optimizations. + bsm_reroute([I,Bl|Is], D, S, Acc); +bsm_reroute([I|Is], D, _, Acc) -> + bsm_reroute(Is, D, none, [I|Acc]); +bsm_reroute([], _, _, Acc) -> reverse(Acc). + +bsm_opt_2([{test,bs_test_tail2,F,[Ctx,Bits]}|Is], + [{test,bs_skip_bits2,F,[Ctx,{integer,I},Unit,_Flags]}|Acc]) -> + bsm_opt_2(Is, [{test,bs_test_tail2,F,[Ctx,Bits+I*Unit]}|Acc]); +bsm_opt_2([{test,bs_skip_bits2,F,[Ctx,{integer,I1},Unit1,_]}|Is], + [{test,bs_skip_bits2,F,[Ctx,{integer,I2},Unit2,Flags]}|Acc]) -> + bsm_opt_2(Is, [{test,bs_skip_bits2,F, + [Ctx,{integer,I1*Unit1+I2*Unit2},1,Flags]}|Acc]); +bsm_opt_2([I|Is], Acc) -> + bsm_opt_2(Is, [I|Acc]); +bsm_opt_2([], Acc) -> reverse(Acc). + +%% bsm_not_bs_test({test,Name,_,Operands}) -> true|false. +%% Test whether is the test is a "safe", i.e. does not move the +%% bit offset for a binary. +%% +%% 'true' means that the test is safe, 'false' that we don't know or +%% that the test moves the offset (e.g. bs_get_integer2). + +bsm_not_bs_test({test,bs_test_tail2,_,[_,_]}) -> true; +bsm_not_bs_test(Test) -> beam_utils:is_pure_test(Test). + +bsm_subst_labels(Fs, Save, D) -> + bsm_subst_labels_1(Fs, Save, D, []). + +bsm_subst_labels_1([F|Fs], Save, D, Acc) -> + bsm_subst_labels_1(Fs, Save, D, [bsm_subst_label(F, Save, D)|Acc]); +bsm_subst_labels_1([], _, _, Acc) -> + reverse(Acc). + +bsm_subst_label({f,Lbl0}=F, Save, D) -> + case gb_trees:lookup({Lbl0,Save}, D) of + {value,Lbl} -> {f,Lbl}; + none -> F + end; +bsm_subst_label(Other, _, _) -> Other. diff --git a/lib/compiler/src/beam_bsm.erl b/lib/compiler/src/beam_bsm.erl index 4f76350269..62356928ae 100644 --- a/lib/compiler/src/beam_bsm.erl +++ b/lib/compiler/src/beam_bsm.erl @@ -421,7 +421,8 @@ btb_follow_branches([], _, D) -> D. btb_follow_branch(0, _Regs, D) -> D; btb_follow_branch(Lbl, Regs, #btb{ok_br=Br0,index=Li}=D) -> - case gb_sets:is_member(Lbl, Br0) of + Key = {Lbl,Regs}, + case gb_sets:is_member(Key, Br0) of true -> %% We have already followed this branch and it was OK. D; @@ -432,7 +433,7 @@ btb_follow_branch(Lbl, Regs, #btb{ok_br=Br0,index=Li}=D) -> btb_reaches_match_1(Is, Regs, D), %% Since we got back, this branch is OK. - D#btb{ok_br=gb_sets:insert(Lbl, Br),must_not_save=MustNotSave, + D#btb{ok_br=gb_sets:insert(Key, Br),must_not_save=MustNotSave, must_save=MustSave} end. diff --git a/lib/compiler/src/beam_clean.erl b/lib/compiler/src/beam_clean.erl index 919ee3ee7d..d9108c383d 100644 --- a/lib/compiler/src/beam_clean.erl +++ b/lib/compiler/src/beam_clean.erl @@ -141,7 +141,7 @@ renumber_labels([{bif,is_record,{f,_}, renumber_labels(Is, Acc, St); renumber_labels([{test,is_record,{f,_}=Fail, [Term,{atom,Tag}=TagAtom,{integer,Arity}]}|Is0], Acc, St) -> - Tmp = {x,1023}, + Tmp = {x,1022}, Is = case is_record_tuple(Term, Tag, Arity) of yes -> Is0; @@ -190,17 +190,11 @@ replace([{test,Test,{f,Lbl},Ops}|Is], Acc, D) -> replace([{test,Test,{f,Lbl},Live,Ops,Dst}|Is], Acc, D) -> replace(Is, [{test,Test,{f,label(Lbl, D)},Live,Ops,Dst}|Acc], D); replace([{select,I,R,{f,Fail0},Vls0}|Is], Acc, D) -> - Vls1 = map(fun ({f,L}) -> {f,label(L, D)}; - (Other) -> Other end, Vls0), + Vls = map(fun ({f,L}) -> {f,label(L, D)}; + (Other) -> Other + end, Vls0), Fail = label(Fail0, D), - case redundant_values(Vls1, Fail, []) of - [] -> - %% Oops, no choices left. The loader will not accept that. - %% Convert to a plain jump. - replace(Is, [{jump,{f,Fail}}|Acc], D); - Vls -> - replace(Is, [{select,I,R,{f,Fail},Vls}|Acc], D) - end; + replace(Is, [{select,I,R,{f,Fail},Vls}|Acc], D); replace([{'try',R,{f,Lbl}}|Is], Acc, D) -> replace(Is, [{'try',R,{f,label(Lbl, D)}}|Acc], D); replace([{'catch',R,{f,Lbl}}|Is], Acc, D) -> @@ -241,12 +235,6 @@ label(Old, D) -> {value,Val} -> Val; none -> throw({error,{undefined_label,Old}}) end. - -redundant_values([_,{f,Fail}|Vls], Fail, Acc) -> - redundant_values(Vls, Fail, Acc); -redundant_values([Val,Lbl|Vls], Fail, Acc) -> - redundant_values(Vls, Fail, [Lbl,Val|Acc]); -redundant_values([], _, Acc) -> reverse(Acc). %%% %%% Final fixup of bs_start_match2/5,bs_save2/bs_restore2 instructions for diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl index ead88b57e9..11129c39bc 100644 --- a/lib/compiler/src/beam_dead.erl +++ b/lib/compiler/src/beam_dead.erl @@ -239,11 +239,26 @@ backward([{test,is_eq_exact,Fail,[Dst,{integer,Arity}]}=I| backward([{label,Lbl}=L|Is], D, Acc) -> backward(Is, beam_utils:index_label(Lbl, Acc, D), [L|Acc]); backward([{select,select_val,Reg,{f,Fail0},List0}|Is], D, Acc) -> - List = shortcut_select_list(List0, Reg, D, []), + List1 = shortcut_select_list(List0, Reg, D, []), Fail1 = shortcut_label(Fail0, D), Fail = shortcut_bs_test(Fail1, Is, D), - Sel = {select,select_val,Reg,{f,Fail},List}, - backward(Is, D, [Sel|Acc]); + List = prune_redundant(List1, Fail), + case List of + [] -> + Jump = {jump,{f,Fail}}, + backward([Jump|Is], D, Acc); + [V,F] -> + Test = {test,is_eq_exact,{f,Fail},[Reg,V]}, + Jump = {jump,F}, + backward([Jump,Test|Is], D, Acc); + [{atom,B1},F,{atom,B2},F] when B1 =:= not B2 -> + Test = {test,is_boolean,{f,Fail},[Reg]}, + Jump = {jump,F}, + backward([Jump,Test|Is], D, Acc); + [_|_] -> + Sel = {select,select_val,Reg,{f,Fail},List}, + backward(Is, D, [Sel|Acc]) + end; backward([{jump,{f,To0}},{move,Src,Reg}=Move|Is], D, Acc) -> To = shortcut_select_label(To0, Reg, Src, D), Jump = {jump,{f,To}}, @@ -257,14 +272,17 @@ backward([{jump,{f,To}}=J|[{bif,Op,_,Ops,Reg}|Is]=Is0], D, Acc) -> catch throw:not_possible -> backward(Is0, D, [J|Acc]) end; -backward([{test,bs_start_match2,F,_,[R,_],Ctxt}=I|Is], D, +backward([{test,bs_start_match2,F,Live,[R,_]=Args,Ctxt}|Is], D, [{test,bs_match_string,F,[Ctxt,Bs]}, {test,bs_test_tail2,F,[Ctxt,0]}|Acc0]=Acc) -> + {f,To0} = F, + To = shortcut_bs_start_match(To0, R, D), case beam_utils:is_killed(Ctxt, Acc0, D) of true -> - Eq = {test,is_eq_exact,F,[R,{literal,Bs}]}, + Eq = {test,is_eq_exact,{f,To},[R,{literal,Bs}]}, backward(Is, D, [Eq|Acc0]); false -> + I = {test,bs_start_match2,{f,To},Live,Args,Ctxt}, backward(Is, D, [I|Acc]) end; backward([{test,bs_start_match2,{f,To0},Live,[Src|_]=Info,Dst}|Is], D, Acc) -> @@ -295,7 +313,28 @@ backward([{test,Op,{f,To0},Ops0}|Is], D, Acc) -> is_eq_exact -> combine_eqs(To, Ops0, D, Acc); _ -> {test,Op,{f,To},Ops0} end, - backward(Is, D, [I|Acc]); + case {I,Acc} of + {{test,is_atom,Fail,Ops0},[{test,is_boolean,Fail,Ops0}|_]} -> + %% An is_atom test before an is_boolean test (with the + %% same failure label) is redundant. + backward(Is, D, Acc); + {{test,is_atom,Fail,[R]}, + [{test,is_eq_exact,Fail,[R,{atom,_}]}|_]} -> + %% An is_atom test before a comparison with an atom (with + %% the same failure label) is redundant. + backward(Is, D, Acc); + {{test,is_integer,Fail,[R]}, + [{test,is_eq_exact,Fail,[R,{integer,_}]}|_]} -> + %% An is_integer test before a comparison with an integer + %% (with the same failure label) is redundant. + backward(Is, D, Acc); + {{test,_,_,_},_} -> + %% Still a test instruction. Done. + backward(Is, D, [I|Acc]); + {_,_} -> + %% Rewritten to a select_val. Rescan. + backward([I|Is], D, Acc) + end; backward([{test,Op,{f,To0},Live,Ops0,Dst}|Is], D, Acc) -> To1 = shortcut_bs_test(To0, Is, D), To2 = shortcut_label(To1, D), @@ -348,6 +387,12 @@ shortcut_label(To0, D) -> shortcut_select_label(To, Reg, Lit, D) -> shortcut_rel_op(To, is_ne_exact, [Reg,Lit], D). +prune_redundant([_,{f,Fail}|T], Fail) -> + prune_redundant(T, Fail); +prune_redundant([V,F|T], Fail) -> + [V,F|prune_redundant(T, Fail)]; +prune_redundant([], _) -> []. + %% Replace a comparison operator with a test instruction and a jump. %% For example, if we have this code: %% diff --git a/lib/compiler/src/beam_dict.erl b/lib/compiler/src/beam_dict.erl index 2b5f8c1b7f..654fb47dbd 100644 --- a/lib/compiler/src/beam_dict.erl +++ b/lib/compiler/src/beam_dict.erl @@ -44,7 +44,7 @@ locals = [] :: [{label(), arity(), label()}], imports = gb_trees:empty() :: import_tab(), strings = <<>> :: binary(), %String pool - lambdas = [], %[{...}] + lambdas = {0,[]}, %[{...}] literals = dict:new() :: literal_tab(), fnames = #{} :: fname_tab(), lines = #{} :: line_tab(), @@ -145,15 +145,14 @@ string(Str, Dict) when is_list(Str) -> -spec lambda(label(), non_neg_integer(), bdict()) -> {non_neg_integer(), bdict()}. -lambda(Lbl, NumFree, #asm{lambdas=Lambdas0}=Dict) -> - OldIndex = length(Lambdas0), +lambda(Lbl, NumFree, #asm{lambdas={OldIndex,Lambdas0}}=Dict) -> %% Set Index the same as OldIndex. Index = OldIndex, %% Initialize OldUniq to 0. It will be set to an unique value %% based on the MD5 checksum of the BEAM code for the module. OldUniq = 0, Lambdas = [{Lbl,{OldIndex,Lbl,Index,NumFree,OldUniq}}|Lambdas0], - {OldIndex,Dict#asm{lambdas=Lambdas}}. + {OldIndex,Dict#asm{lambdas={OldIndex+1,Lambdas}}}. %% Returns the index for a literal (adding it to the literal table if necessary). %% literal(Literal, Dict) -> {Index,Dict'} @@ -236,13 +235,13 @@ string_table(#asm{strings=Strings,string_offset=Size}) -> -spec lambda_table(bdict()) -> {non_neg_integer(), [<<_:192>>]}. -lambda_table(#asm{locals=Loc0,lambdas=Lambdas0}) -> +lambda_table(#asm{locals=Loc0,lambdas={NumLambdas,Lambdas0}}) -> Lambdas1 = sofs:relation(Lambdas0), Loc = sofs:relation([{Lbl,{F,A}} || {F,A,Lbl} <- Loc0]), Lambdas2 = sofs:relative_product1(Lambdas1, Loc), Lambdas = [<<F:32,A:32,Lbl:32,Index:32,NumFree:32,OldUniq:32>> || {{_,Lbl,Index,NumFree,OldUniq},{F,A}} <- sofs:to_external(Lambdas2)], - {length(Lambdas),Lambdas}. + {NumLambdas,Lambdas}. %% Returns the literal table. %% literal_table(Dict) -> {NumLiterals, [<<TermSize>>,TermInExternalFormat]} diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl index 5e58e0f6ac..3b6eb19fe8 100644 --- a/lib/compiler/src/beam_jump.erl +++ b/lib/compiler/src/beam_jump.erl @@ -495,7 +495,7 @@ is_label_used_in_block({set,_,_,Info}, Lbl) -> {alloc,_,{gc_bif,_,{f,F}}} -> F =:= Lbl; {alloc,_,{put_map,_,{f,F}}} -> F =:= Lbl; {get_map_elements,{f,F}} -> F =:= Lbl; - {'catch',{f,F}} -> F =:= Lbl; + {try_catch,_,{f,F}} -> F =:= Lbl; {alloc,_,_} -> false; {put_tuple,_} -> false; {get_tuple_element,_} -> false; diff --git a/lib/compiler/src/beam_peep.erl b/lib/compiler/src/beam_peep.erl index 17fd2e502a..0c1abfe6a0 100644 --- a/lib/compiler/src/beam_peep.erl +++ b/lib/compiler/src/beam_peep.erl @@ -65,18 +65,6 @@ function({function,Name,Arity,CLabel,Is0}) -> %% InEncoding =:= latin1, OutEncoding =:= unicode; %% InEncoding =:= latin1, OutEncoding =:= utf8 -> %% -%% (2) A select_val/4 instruction that only verifies that -%% its argument is either 'true' or 'false' can be -%% be replaced with an is_boolean/2 instruction. That is: -%% -%% select_val Reg Fail [ true Next false Next ] -%% Next: ... -%% -%% can be rewritten to -%% -%% is_boolean Fail Reg -%% Next: ... -%% peep(Is) -> peep(Is, gb_sets:empty(), []). @@ -95,12 +83,16 @@ peep([{gc_bif,_,_,_,_,Dst}=I|Is], SeenTests0, Acc) -> %% Kill all remembered tests that depend on the destination register. SeenTests = kill_seen(Dst, SeenTests0), peep(Is, SeenTests, [I|Acc]); -peep([{test,is_boolean,{f,Fail},Ops}|_]=Is, SeenTests, - [{test,is_atom,{f,Fail},Ops}|Acc]) -> - %% The previous is_atom/2 test (with the same failure label) is redundant. - %% (If is_boolean(Src) is true, is_atom(Src) is also true, so it is - %% OK to still remember that we have seen is_atom/1.) - peep(Is, SeenTests, Acc); +peep([{select,Op,R,F,Vls0}|Is], _, Acc) -> + case prune_redundant_values(Vls0, F) of + [] -> + %% No values left. Must convert to plain jump. + I = {jump,F}, + peep(Is, gb_sets:empty(), [I|Acc]); + [_|_]=Vls -> + I = {select,Op,R,F,Vls}, + peep(Is, gb_sets:empty(), [I|Acc]) + end; peep([{test,Op,_,Ops}=I|Is], SeenTests0, Acc) -> case beam_utils:is_pure_test(I) of false -> @@ -121,16 +113,6 @@ peep([{test,Op,_,Ops}=I|Is], SeenTests0, Acc) -> peep(Is, SeenTests, [I|Acc]) end end; -peep([{select,select_val,Src,Fail, - [{atom,false},{f,L},{atom,true},{f,L}]}| - [{label,L}|_]=Is], SeenTests, Acc) -> - I = {test,is_boolean,Fail,[Src]}, - peep([I|Is], SeenTests, Acc); -peep([{select,select_val,Src,Fail, - [{atom,true},{f,L},{atom,false},{f,L}]}| - [{label,L}|_]=Is], SeenTests, Acc) -> - I = {test,is_boolean,Fail,[Src]}, - peep([I|Is], SeenTests, Acc); peep([I|Is], _, Acc) -> %% An unknown instruction. Throw away all information we %% have collected about test instructions. @@ -155,3 +137,9 @@ kill_seen_1([{_,Ops}=Test|T], Dst) -> false -> [Test|kill_seen_1(T, Dst)] end; kill_seen_1([], _) -> []. + +prune_redundant_values([_Val,F|Vls], F) -> + prune_redundant_values(Vls, F); +prune_redundant_values([Val,Lbl|Vls], F) -> + [Val,Lbl|prune_redundant_values(Vls, F)]; +prune_redundant_values([], _) -> []. diff --git a/lib/compiler/src/beam_reorder.erl b/lib/compiler/src/beam_reorder.erl new file mode 100644 index 0000000000..41586a7bf2 --- /dev/null +++ b/lib/compiler/src/beam_reorder.erl @@ -0,0 +1,139 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2013. 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_reorder). + +-export([module/2]). +-import(lists, [member/2,reverse/1]). + +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 = reorder(Is0), + {function,Name,Arity,CLabel,Is} + catch + Class:Error -> + Stack = erlang:get_stacktrace(), + io:fwrite("Function: ~w/~w\n", [Name,Arity]), + erlang:raise(Class, Error, Stack) + end. + +%% reorder(Instructions0) -> Instructions +%% Reorder instructions before the beam_block pass, because reordering +%% will be more cumbersome when the blocks are in place. +%% +%% Execution of get_tuple_element instructions can be delayed until +%% they are actually needed. Consider the sequence: +%% +%% get_tuple_element Tuple Pos Dst +%% test Test Fail Operands +%% +%% If Dst is killed at label Fail (and not referenced in Operands), +%% we can can swap the instructions: +%% +%% test Test Fail Operands +%% get_tuple_element Tuple Pos Dst +%% +%% That can be beneficial in two ways: Firstly, if the branch is taken +%% we have avoided execution of the get_tuple_element instruction. +%% Secondly, even if the branch is not taken, subsequent optimization +%% (opt_blocks/1) may be able to change Dst to the final destination +%% register and eliminate a 'move' instruction. + +reorder(Is) -> + D = beam_utils:index_labels(Is), + reorder_1(Is, D, []). + +reorder_1([{Op,_,_}=TryCatch|[I|Is]=Is0], D, Acc) + when Op =:= 'catch'; Op =:= 'try' -> + %% Don't allow 'try' or 'catch' instructions to split blocks if + %% it can be avoided. + case is_safe(I) of + false -> + reorder_1(Is0, D, [TryCatch|Acc]); + true -> + reorder_1([TryCatch|Is], D, [I|Acc]) + end; +reorder_1([{label,L}=I|_], D, Acc) -> + Is = beam_utils:code_at(L, D), + reorder_1(Is, D, [I|Acc]); +reorder_1([{test,is_nonempty_list,_,_}=I|Is], D, Acc) -> + %% The run-time system may combine the is_nonempty_list test with + %% the following get_list instruction. + reorder_1(Is, D, [I|Acc]); +reorder_1([{test,_,_,_}=I, + {select,_,_,_,_}=S|Is], D, Acc) -> + %% There is nothing to gain by inserting a get_tuple_element + %% instruction between the test instruction and the select + %% instruction. + reorder_1(Is, D, [S,I|Acc]); +reorder_1([{test,_,{f,L},Ss}=I|Is0], D0, + [{get_tuple_element,_,_,El}=G|Acc0]=Acc) -> + case member(El, Ss) of + true -> + reorder_1(Is0, D0, [I|Acc]); + false -> + case beam_utils:is_killed_at(El, L, D0) of + true -> + Is = [I,G|Is0], + reorder_1(Is, D0, Acc0); + false -> + case beam_utils:is_killed(El, Is0, D0) of + true -> + Code0 = beam_utils:code_at(L, D0), + Code = [G|Code0], + D = beam_utils:index_label(L, Code, D0), + Is = [I|Is0], + reorder_1(Is, D, Acc0); + false -> + reorder_1(Is0, D0, [I|Acc]) + end + end + end; +reorder_1([{allocate_zero,N,Live}=I0|Is], D, + [{get_tuple_element,{x,Tup},_,{x,Dst}}=G|Acc]=Acc0) -> + case Tup < Dst andalso Dst+1 =:= Live of + true -> + %% Move allocation instruction upwards past + %% get_tuple_element instructions to create more + %% opportunities for moving get_tuple_element + %% instructions. + I = {allocate_zero,N,Dst}, + reorder_1([I,G|Is], D, Acc); + false -> + reorder_1(Is, D, [I0|Acc0]) + end; +reorder_1([I|Is], D, Acc) -> + reorder_1(Is, D, [I|Acc]); +reorder_1([], _, Acc) -> reverse(Acc). + +%% is_safe(Instruction) -> true|false +%% Test whether an instruction is safe (cannot cause an exception). + +is_safe({kill,_}) -> true; +is_safe({move,_,_}) -> true; +is_safe({put,_}) -> true; +is_safe({put_list,_,_,_}) -> true; +is_safe({put_tuple,_,_}) -> true; +is_safe({test_heap,_,_}) -> true; +is_safe(_) -> false. diff --git a/lib/compiler/src/beam_split.erl b/lib/compiler/src/beam_split.erl index 3be9311080..bb1c0e23a9 100644 --- a/lib/compiler/src/beam_split.erl +++ b/lib/compiler/src/beam_split.erl @@ -57,8 +57,8 @@ split_block([{set,[D],[S|Puts],{alloc,R,{put_map,Op,{f,Lbl}=Fail}}}|Is], split_block([{set,Ds,[S|Ss],{get_map_elements,Fail}}|Is], Bl, Acc) -> Gets = beam_utils:join_even(Ss,Ds), split_block(Is, [], [{get_map_elements,Fail,S,{list,Gets}}|make_block(Bl, Acc)]); -split_block([{set,[R],[],{'catch',L}}|Is], Bl, Acc) -> - split_block(Is, [], [{'catch',R,L}|make_block(Bl, Acc)]); +split_block([{set,[R],[],{try_catch,Op,L}}|Is], Bl, Acc) -> + split_block(Is, [], [{Op,R,L}|make_block(Bl, Acc)]); split_block([{set,[],[],{line,_}=Line}|Is], Bl, Acc) -> split_block(Is, [], [Line|make_block(Bl, Acc)]); split_block([I|Is], Bl, Acc) -> diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index 5298589f83..4b45c28623 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -23,7 +23,8 @@ -export([module/2]). --import(lists, [foldl/3,reverse/1,filter/2]). +-import(lists, [filter/2,foldl/3,keyfind/3,member/2, + reverse/1,reverse/2,sort/1]). module({Mod,Exp,Attr,Fs0,Lc}, _Opts) -> Fs = [function(F) || F <- Fs0], @@ -92,8 +93,19 @@ simplify_basic_1([{set,[D],[TupleReg],{get_tuple_element,0}}=I|Is0], Ts0, Acc) - Ts = update(I, Ts0), simplify_basic_1(Is0, Ts, [I|Acc]) end; -simplify_basic_1([{set,_,_,{'catch',_}}=I|Is], _Ts, Acc) -> +simplify_basic_1([{set,_,_,{try_catch,_,_}}=I|Is], _Ts, Acc) -> simplify_basic_1(Is, tdb_new(), [I|Acc]); +simplify_basic_1([{test,is_atom,_,[R]}=I|Is], Ts, Acc) -> + case tdb_find(R, Ts) of + boolean -> simplify_basic_1(Is, Ts, Acc); + _ -> simplify_basic_1(Is, Ts, [I|Acc]) + end; +simplify_basic_1([{test,is_integer,_,[R]}=I|Is], Ts, Acc) -> + case tdb_find(R, Ts) of + integer -> simplify_basic_1(Is, Ts, Acc); + {integer,_} -> simplify_basic_1(Is, Ts, Acc); + _ -> simplify_basic_1(Is, Ts, [I|Acc]) + end; simplify_basic_1([{test,is_tuple,_,[R]}=I|Is], Ts, Acc) -> case tdb_find(R, Ts) of {tuple,_,_} -> simplify_basic_1(Is, Ts, Acc); @@ -137,6 +149,16 @@ simplify_basic_1([{test,is_record,_,[R,{atom,_}=Tag,{integer,Arity}]}=I|Is], Ts0 Ts = update(I, Ts0), simplify_basic_1(Is, Ts, [I|Acc]) end; +simplify_basic_1([{select,select_val,Reg,_,_}=I0|Is], Ts, Acc) -> + I = case tdb_find(Reg, Ts) of + {integer,Range} -> + simplify_select_val_int(I0, Range); + boolean -> + simplify_select_val_bool(I0); + _ -> + I0 + end, + simplify_basic_1(Is, tdb_new(), [I|Acc]); simplify_basic_1([I|Is], Ts0, Acc) -> Ts = update(I, Ts0), simplify_basic_1(Is, Ts, [I|Acc]); @@ -144,6 +166,32 @@ simplify_basic_1([], Ts, Acc) -> Is = reverse(Acc), {Is,Ts}. +simplify_select_val_int({select,select_val,R,_,L0}=I, {Min,Max}) -> + Vs = sort([V || {integer,V} <- L0]), + case eq_ranges(Vs, Min, Max) of + false -> I; + true -> simplify_select_val_1(L0, {integer,Max}, R, []) + end. + +simplify_select_val_bool({select,select_val,R,_,L}=I) -> + Vs = sort([V || {atom,V} <- L]), + case Vs of + [false,true] -> + simplify_select_val_1(L, {atom,false}, R, []); + _ -> + I + end. + +simplify_select_val_1([Val,F|T], Val, R, Acc) -> + L = reverse(Acc, T), + {select,select_val,R,F,L}; +simplify_select_val_1([V,F|T], Val, R, Acc) -> + simplify_select_val_1(T, Val, R, [F,V|Acc]). + +eq_ranges([H], H, H) -> true; +eq_ranges([H|T], H, Max) -> eq_ranges(T, H+1, Max); +eq_ranges(_, _, _) -> false. + %% simplify_float([Instruction], TypeDatabase) -> %% {[Instruction],TypeDatabase'} | not_possible %% Simplify floating point operations in blocks. @@ -199,7 +247,7 @@ simplify_float_1([{set,[D0],[A0,B0],{alloc,_,{gc_bif,Op0,{f,0}}}}=I|Is]=Is0, Ts = tdb_update([{D0,float}], Ts0), simplify_float_1(Is, Ts, Rs, Acc) end; -simplify_float_1([{set,_,_,{'catch',_}}=I|Is]=Is0, _Ts, Rs0, Acc0) -> +simplify_float_1([{set,_,_,{try_catch,_,_}}=I|Is]=Is0, _Ts, Rs0, Acc0) -> Acc = flush_all(Rs0, Is0, Acc0), simplify_float_1(Is, tdb_new(), Rs0, [I|Acc]); simplify_float_1([{set,_,_,{line,_}}=I|Is], Ts, Rs, Acc) -> @@ -311,7 +359,7 @@ flt_need_heap_2({set,_,_,{get_tuple_element,_}}, H, Fl) -> {[],H,Fl}; flt_need_heap_2({set,_,_,get_list}, H, Fl) -> {[],H,Fl}; -flt_need_heap_2({set,_,_,{'catch',_}}, H, Fl) -> +flt_need_heap_2({set,_,_,{try_catch,_,_}}, H, Fl) -> {[],H,Fl}; %% All other instructions should cause the insertion of an allocation %% instruction if needed. @@ -382,6 +430,17 @@ update({set,[D],[{integer,I},Reg],{bif,element,_}}, Ts0) -> tdb_update([{Reg,{tuple,I,[]}},{D,kill}], Ts0); update({set,[D],[_Index,Reg],{bif,element,_}}, Ts0) -> tdb_update([{Reg,{tuple,0,[]}},{D,kill}], Ts0); +update({set,[D],Args,{bif,N,_}}, Ts0) -> + Ar = length(Args), + BoolOp = erl_internal:new_type_test(N, Ar) orelse + erl_internal:comp_op(N, Ar) orelse + erl_internal:bool_op(N, Ar), + case BoolOp of + true -> + tdb_update([{D,boolean}], Ts0); + false -> + tdb_update([{D,kill}], Ts0) + end; update({set,[D],[S],{get_tuple_element,0}}, Ts) -> tdb_update([{D,{tuple_element,S,0}}], Ts); update({set,[D],[S],{alloc,_,{gc_bif,float,{f,0}}}}, Ts0) -> @@ -390,6 +449,13 @@ update({set,[D],[S],{alloc,_,{gc_bif,float,{f,0}}}}, Ts0) -> true -> tdb_update([{D,float}], Ts0); false -> Ts0 end; +update({set,[D],[S1,S2],{alloc,_,{gc_bif,'band',{f,0}}}}, Ts) -> + case keyfind(integer, 1, [S1,S2]) of + {integer,N} -> + update_band(N, D, Ts); + false -> + tdb_update([{D,integer}], Ts) + end; update({set,[D],[S1,S2],{alloc,_,{gc_bif,'/',{f,0}}}}, Ts0) -> %% Make sure we reject non-numeric literals. case possibly_numeric(S1) andalso possibly_numeric(S2) of @@ -397,15 +463,17 @@ update({set,[D],[S1,S2],{alloc,_,{gc_bif,'/',{f,0}}}}, Ts0) -> false -> Ts0 end; update({set,[D],[S1,S2],{alloc,_,{gc_bif,Op,{f,0}}}}, Ts0) -> - case arith_op(Op) of - no -> - tdb_update([{D,kill}], Ts0); - {yes,_} -> + case op_type(Op) of + integer -> + tdb_update([{D,integer}], Ts0); + {float,_} -> case {tdb_find(S1, Ts0),tdb_find(S2, Ts0)} of {float,_} -> tdb_update([{D,float}], Ts0); {_,float} -> tdb_update([{D,float}], Ts0); {_,_} -> tdb_update([{D,kill}], Ts0) - end + end; + unknown -> + tdb_update([{D,kill}], Ts0) end; update({set,[],_Src,_Op}, Ts0) -> Ts0; update({set,[D],_Src,_Op}, Ts0) -> @@ -437,6 +505,8 @@ update({test,is_record,_Fail,[Src,Tag,{integer,Arity}]}, Ts) -> tdb_update([{Src,{tuple,Arity,[Tag]}}], Ts); update({test,_Test,_Fail,_Other}, Ts) -> Ts; +update({test,bs_get_integer2,_,_,Args,Dst}, Ts) -> + tdb_update([{Dst,get_bs_integer_type(Args)}], Ts); update({call_ext,Ar,{extfunc,math,Math,Ar}}, Ts) -> case is_math_bif(Math, Ar) of true -> tdb_update([{{x,0},float}], Ts); @@ -453,10 +523,43 @@ update({call,_Arity,_Func}, Ts) -> tdb_kill_xregs(Ts); update({call_ext,_Arity,_Func}, Ts) -> tdb_kill_xregs(Ts); update({make_fun2,_,_,_,_}, Ts) -> tdb_kill_xregs(Ts); update({line,_}, Ts) -> Ts; +update({bs_save2,_,_}, Ts) -> Ts; +update({bs_restore2,_,_}, Ts) -> Ts; %% The instruction is unknown. Kill all information. update(_I, _Ts) -> tdb_new(). +update_band(N, Reg, Ts) -> + Type = update_band_1(N, 0), + tdb_update([{Reg,Type}], Ts). + +update_band_1(N, Bits) when Bits < 64 -> + case 1 bsl Bits of + P when P =:= N + 1 -> + {integer,{0,N}}; + P when P > N + 1 -> + integer; + _ -> + update_band_1(N, Bits+1) + end; +update_band_1(_, _) -> + %% Negative or large positive number. Give up. + integer. + +get_bs_integer_type([_,{integer,N},U,{field_flags,Fl}]) + when N*U < 64 -> + NumBits = N*U, + case member(unsigned, Fl) of + true -> + {integer,{0,(1 bsl NumBits)-1}}; + false -> + %% Signed integer. Don't bother. + integer + end; +get_bs_integer_type(_) -> + %% Avoid creating ranges with a huge upper limit. + integer. + is_math_bif(cos, 1) -> true; is_math_bif(cosh, 1) -> true; is_math_bif(sin, 1) -> true; @@ -545,11 +648,22 @@ load_reg(V, Ts, Rs0, Is0) -> {Rs,Is} end. -arith_op('+') -> {yes,fadd}; -arith_op('-') -> {yes,fsub}; -arith_op('*') -> {yes,fmul}; -arith_op('/') -> {yes,fdiv}; -arith_op(_) -> no. +arith_op(Op) -> + case op_type(Op) of + {float,Instr} -> {yes,Instr}; + _ -> no + end. + +op_type('+') -> {float,fadd}; +op_type('-') -> {float,fsub}; +op_type('*') -> {float,fmul}; +%% '/' and 'band' are specially handled. +op_type('bor') -> integer; +op_type('bxor') -> integer; +op_type('bsl') -> integer; +op_type('bsr') -> integer; +op_type('div') -> integer; +op_type(_) -> unknown. flush(Rs, [{set,[_],[],{put_tuple,_}}|_]=Is0, Acc0) -> Acc = flush_all(Rs, Is0, Acc0), @@ -618,7 +732,6 @@ checkerror(Is) -> checkerror_1(Is, Is). checkerror_1([{set,[],[],fcheckerror}|_], OrigIs) -> OrigIs; -checkerror_1([{set,[],[],fclearerror}|_], OrigIs) -> OrigIs; checkerror_1([{set,_,_,{bif,fadd,_}}|_], OrigIs) -> checkerror_2(OrigIs); checkerror_1([{set,_,_,{bif,fsub,_}}|_], OrigIs) -> checkerror_2(OrigIs); checkerror_1([{set,_,_,{bif,fmul,_}}|_], OrigIs) -> checkerror_2(OrigIs); @@ -640,6 +753,9 @@ checkerror_2(OrigIs) -> [{set,[],[],fcheckerror}|OrigIs]. %%% of the first element). %%% %%% 'float' means that the register contains a float. +%%% +%%% 'integer' or {integer,{Min,Max}} that the register contains an +%%% integer. %% tdb_new() -> EmptyDataBase %% Creates a new, empty type database. @@ -729,10 +845,20 @@ merge_type_info({tuple,Sz1,[]}, {tuple,_Sz2,First}=Tuple2) -> merge_type_info({tuple,Sz1,First}, Tuple2); merge_type_info({tuple,_Sz1,First}=Tuple1, {tuple,Sz2,_}) -> merge_type_info(Tuple1, {tuple,Sz2,First}); +merge_type_info(integer, {integer,_}=Int) -> + Int; +merge_type_info({integer,_}=Int, integer) -> + Int; +merge_type_info({integer,{Min1,Max1}}, {integer,{Min2,Max2}}) -> + {integer,{max(Min1, Min2),min(Max1, Max2)}}; merge_type_info(NewType, _) -> verify_type(NewType), NewType. +verify_type(boolean) -> ok; +verify_type(integer) -> ok; +verify_type({integer,{Min,Max}}) + when is_integer(Min), is_integer(Max) -> ok; verify_type(map) -> ok; verify_type(nonempty_list) -> ok; verify_type({tuple,Sz,[]}) when is_integer(Sz) -> ok; diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index fbcd5de1bb..68d6105cfa 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -484,6 +484,15 @@ check_liveness(R, [{get_map_elements,{f,Fail},S,{list,L}}|Is], St0) -> Other end end; +check_liveness(R, [{test_heap,N,Live}|Is], St) -> + I = {block,[{set,[],[],{alloc,Live,{nozero,nostack,N,[]}}}]}, + check_liveness(R, [I|Is], St); +check_liveness(R, [{allocate_zero,N,Live}|Is], St) -> + I = {block,[{set,[],[],{alloc,Live,{zero,N,0,[]}}}]}, + check_liveness(R, [I|Is], St); +check_liveness(R, [{get_list,S,D1,D2}|Is], St) -> + I = {block,[{set,[D1,D2],[S],get_list}]}, + check_liveness(R, [I|Is], St); check_liveness(_R, Is, St) when is_list(Is) -> %% case Is of %% [I|_] -> diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 6004f1974e..fd38fc0095 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -31,15 +31,6 @@ -import(lists, [reverse/1,foldl/3,foreach/2,dropwhile/2]). --define(MAXREG, 1024). - -%%-define(DEBUG, 1). --ifdef(DEBUG). --define(DBG_FORMAT(F, D), (io:format((F), (D)))). --else. --define(DBG_FORMAT(F, D), ok). --endif. - %% To be called by the compiler. module({Mod,Exp,Attr,Fs,Lc}=Code, _Opts) when is_atom(Mod), is_list(Exp), is_list(Attr), is_integer(Lc) -> @@ -170,29 +161,18 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) -> % in the module (those that start with bs_start_match2). }). --ifdef(DEBUG). -print_st(#st{x=Xs,y=Ys,numy=NumY,h=H,ct=Ct}) -> - io:format(" #st{x=~p~n" - " y=~p~n" - " numy=~p,h=~p,ct=~w~n", - [gb_trees:to_list(Xs),gb_trees:to_list(Ys),NumY,H,Ct]). --endif. - validate_1(Is, Name, Arity, Entry, Ft) -> validate_2(labels(Is), Name, Arity, Entry, Ft). validate_2({Ls1,[{func_info,{atom,Mod},{atom,Name},Arity}=_F|Is]}, Name, Arity, Entry, Ft) -> - lists:foreach(fun (_L) -> ?DBG_FORMAT(" ~p.~n", [{label,_L}]) end, Ls1), - ?DBG_FORMAT(" ~p.~n", [_F]), validate_3(labels(Is), Name, Arity, Entry, Mod, Ls1, Ft); validate_2({Ls1,Is}, Name, Arity, _Entry, _Ft) -> error({{'_',Name,Arity},{first(Is),length(Ls1),illegal_instruction}}). validate_3({Ls2,Is}, Name, Arity, Entry, Mod, Ls1, Ft) -> - lists:foreach(fun (_L) -> ?DBG_FORMAT(" ~p.~n", [{label,_L}]) end, Ls2), Offset = 1 + length(Ls1) + 1 + length(Ls2), - EntryOK = (Entry =:= undefined) orelse lists:member(Entry, Ls2), + EntryOK = lists:member(Entry, Ls2), if EntryOK -> St = init_state(Arity), @@ -260,7 +240,6 @@ valfun([], MFA, _Offset, #vst{branched=Targets0,labels=Labels0}=Vst) -> error({MFA,Error}) end; valfun([I|Is], MFA, Offset, Vst0) -> - ?DBG_FORMAT(" ~p.\n", [I]), valfun(Is, MFA, Offset+1, try Vst = val_dsetel(I, Vst0), @@ -278,7 +257,6 @@ valfun_1({label,Lbl}, #vst{current=St0,branched=B,labels=Lbls}=Vst) -> valfun_1(_I, #vst{current=none}=Vst) -> %% Ignore instructions after erlang:error/1,2, which %% the original R10B compiler thought would return. - ?DBG_FORMAT("Ignoring ~p\n", [_I]), Vst; valfun_1({badmatch,Src}, Vst) -> assert_term(Src, Vst), @@ -980,9 +958,9 @@ get_fls(#vst{current=#st{fls=Fls}}) when is_atom(Fls) -> Fls. init_fregs() -> 0. -set_freg({fr,Fr}, #vst{current=#st{f=Fregs0}=St}=Vst) +set_freg({fr,Fr}=Freg, #vst{current=#st{f=Fregs0}=St}=Vst) when is_integer(Fr), 0 =< Fr -> - limit_check(Fr), + check_limit(Freg), Bit = 1 bsl Fr, if Fregs0 band Bit =:= 0 -> @@ -995,9 +973,10 @@ set_freg(Fr, _) -> error({bad_target,Fr}). assert_freg_set({fr,Fr}=Freg, #vst{current=#st{f=Fregs}}) when is_integer(Fr), 0 =< Fr -> if - Fregs band (1 bsl Fr) =/= 0 -> - limit_check(Fr); - true -> error({uninitialized_reg,Freg}) + (Fregs bsr Fr) band 1 =:= 0 -> + error({uninitialized_reg,Freg}); + true -> + ok end; assert_freg_set(Fr, _) -> error({bad_source,Fr}). @@ -1076,16 +1055,16 @@ set_type(Type, {x,_}=Reg, Vst) -> set_type_reg(Type, Reg, Vst); set_type(Type, {y,_}=Reg, Vst) -> set_type_y(Type, Reg, Vst); set_type(_, _, #vst{}=Vst) -> Vst. -set_type_reg(Type, {x,X}, #vst{current=#st{x=Xs}=St}=Vst) +set_type_reg(Type, {x,X}=Reg, #vst{current=#st{x=Xs}=St}=Vst) when is_integer(X), 0 =< X -> - limit_check(X), + check_limit(Reg), Vst#vst{current=St#st{x=gb_trees:enter(X, Type, Xs)}}; set_type_reg(Type, Reg, Vst) -> set_type_y(Type, Reg, Vst). set_type_y(Type, {y,Y}=Reg, #vst{current=#st{y=Ys0}=St}=Vst) when is_integer(Y), 0 =< Y -> - limit_check(Y), + check_limit(Reg), Ys = case gb_trees:lookup(Y, Ys0) of none -> error({invalid_store,Reg,Type}); @@ -1612,17 +1591,19 @@ return_type_math(pow, 2) -> {float,[]}; return_type_math(pi, 0) -> {float,[]}; return_type_math(F, A) when is_atom(F), is_integer(A), A >= 0 -> term. -limit_check(Num) when is_integer(Num), Num >= ?MAXREG -> - error(limit); -limit_check(_) -> ok. +check_limit({x,X}) when is_integer(X), X < 1023 -> + %% Note: x(1023) is reserved for use by the BEAM loader. + ok; +check_limit({y,Y}) when is_integer(Y), Y < 1024 -> + ok; +check_limit({fr,Fr}) when is_integer(Fr), Fr < 1024 -> + ok; +check_limit(_) -> + error(limit). min(A, B) when is_integer(A), is_integer(B), A < B -> A; min(A, B) when is_integer(A), is_integer(B) -> B. gb_trees_from_list(L) -> gb_trees:from_orddict(lists:sort(L)). --ifdef(DEBUG). -error(Error) -> exit(Error). --else. error(Error) -> throw(Error). --endif. diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl index 010327b5e3..e7a2b8177a 100644 --- a/lib/compiler/src/cerl.erl +++ b/lib/compiler/src/cerl.erl @@ -1598,13 +1598,20 @@ is_c_map(#c_literal{val = V}) when is_map(V) -> is_c_map(_) -> false. --spec map_es(c_map()) -> [c_map_pair()]. +-spec map_es(c_map() | c_literal()) -> [c_map_pair()]. +map_es(#c_literal{anno=As,val=M}) when is_map(M) -> + [ann_c_map_pair(As, + #c_literal{anno=As,val='assoc'}, + #c_literal{anno=As,val=K}, + #c_literal{anno=As,val=V}) || {K,V} <- maps:to_list(M)]; map_es(#c_map{es = Es}) -> Es. --spec map_arg(c_map()) -> c_map() | c_literal(). +-spec map_arg(c_map() | c_literal()) -> c_map() | c_literal(). +map_arg(#c_literal{anno=As,val=M}) when is_map(M) -> + #c_literal{anno=As,val=#{}}; map_arg(#c_map{arg=M}) -> M. diff --git a/lib/compiler/src/cerl_trees.erl b/lib/compiler/src/cerl_trees.erl index 58bb18e34a..b86be95cab 100644 --- a/lib/compiler/src/cerl_trees.erl +++ b/lib/compiler/src/cerl_trees.erl @@ -27,7 +27,7 @@ -module(cerl_trees). -export([depth/1, fold/3, free_variables/1, get_label/1, label/1, label/2, - map/2, mapfold/3, size/1, variables/1]). + map/2, mapfold/3, mapfold/4, size/1, variables/1]). -import(cerl, [alias_pat/1, alias_var/1, ann_c_alias/3, ann_c_apply/3, ann_c_binary/2, ann_c_bitstr/6, ann_c_call/4, @@ -340,136 +340,162 @@ fold_pairs(_, S, []) -> %% starting with the given value <code>Initial</code>, while doing a %% post-order traversal of the tree, much like <code>fold/3</code>. %% +%% This is the same as mapfold/4, with an identity function as the +%% pre-operation. +%% %% @see map/2 %% @see fold/3 +%% @see mapfold/4 -spec mapfold(fun((cerl:cerl(), term()) -> {cerl:cerl(), term()}), term(), cerl:cerl()) -> {cerl:cerl(), term()}. mapfold(F, S0, T) -> + mapfold(fun(T0, A) -> {T0, A} end, F, S0, T). + + +%% @spec mapfold(Pre, Post, Initial::term(), Tree::cerl()) -> +%% {cerl(), term()} +%% +%% Pre = Post = (cerl(), term()) -> {cerl(), term()} +%% +%% @doc Does a combined map/fold operation on the nodes of the +%% tree. It begins by calling <code>Pre</code> on the tree, using the +%% <code>Initial</code> value. It then deconstructs the top node of +%% the returned tree and recurses on the children, using the returned +%% value as the new initial and carrying the returned values from one +%% call to the next. Finally it reassembles the top node from the +%% children, calls <code>Post</code> on it and returns the result. + +-spec mapfold(fun((cerl:cerl(), term()) -> {cerl:cerl(), term()}), + fun((cerl:cerl(), term()) -> {cerl:cerl(), term()}), + term(), cerl:cerl()) -> {cerl:cerl(), term()}. + +mapfold(Pre, Post, S00, T0) -> + {T, S0} = Pre(T0, S00), case type(T) of literal -> case concrete(T) of [_ | _] -> - {T1, S1} = mapfold(F, S0, cons_hd(T)), - {T2, S2} = mapfold(F, S1, cons_tl(T)), - F(update_c_cons(T, T1, T2), S2); + {T1, S1} = mapfold(Pre, Post, S0, cons_hd(T)), + {T2, S2} = mapfold(Pre, Post, S1, cons_tl(T)), + Post(update_c_cons(T, T1, T2), S2); V when tuple_size(V) > 0 -> - {Ts, S1} = mapfold_list(F, S0, tuple_es(T)), - F(update_c_tuple(T, Ts), S1); + {Ts, S1} = mapfold_list(Pre, Post, S0, tuple_es(T)), + Post(update_c_tuple(T, Ts), S1); _ -> - F(T, S0) + Post(T, S0) end; var -> - F(T, S0); + Post(T, S0); values -> - {Ts, S1} = mapfold_list(F, S0, values_es(T)), - F(update_c_values(T, Ts), S1); + {Ts, S1} = mapfold_list(Pre, Post, S0, values_es(T)), + Post(update_c_values(T, Ts), S1); cons -> - {T1, S1} = mapfold(F, S0, cons_hd(T)), - {T2, S2} = mapfold(F, S1, cons_tl(T)), - F(update_c_cons_skel(T, T1, T2), S2); + {T1, S1} = mapfold(Pre, Post, S0, cons_hd(T)), + {T2, S2} = mapfold(Pre, Post, S1, cons_tl(T)), + Post(update_c_cons_skel(T, T1, T2), S2); tuple -> - {Ts, S1} = mapfold_list(F, S0, tuple_es(T)), - F(update_c_tuple_skel(T, Ts), S1); + {Ts, S1} = mapfold_list(Pre, Post, S0, tuple_es(T)), + Post(update_c_tuple_skel(T, Ts), S1); map -> - {M , S1} = mapfold(F, S0, map_arg(T)), - {Ts, S2} = mapfold_list(F, S1, map_es(T)), - F(update_c_map(T, M, Ts), S2); + {M , S1} = mapfold(Pre, Post, S0, map_arg(T)), + {Ts, S2} = mapfold_list(Pre, Post, S1, map_es(T)), + Post(update_c_map(T, M, Ts), S2); map_pair -> - {Op, S1} = mapfold(F, S0, map_pair_op(T)), - {Key, S2} = mapfold(F, S1, map_pair_key(T)), - {Val, S3} = mapfold(F, S2, map_pair_val(T)), - F(update_c_map_pair(T,Op,Key,Val), S3); + {Op, S1} = mapfold(Pre, Post, S0, map_pair_op(T)), + {Key, S2} = mapfold(Pre, Post, S1, map_pair_key(T)), + {Val, S3} = mapfold(Pre, Post, S2, map_pair_val(T)), + Post(update_c_map_pair(T,Op,Key,Val), S3); 'let' -> - {Vs, S1} = mapfold_list(F, S0, let_vars(T)), - {A, S2} = mapfold(F, S1, let_arg(T)), - {B, S3} = mapfold(F, S2, let_body(T)), - F(update_c_let(T, Vs, A, B), S3); + {Vs, S1} = mapfold_list(Pre, Post, S0, let_vars(T)), + {A, S2} = mapfold(Pre, Post, S1, let_arg(T)), + {B, S3} = mapfold(Pre, Post, S2, let_body(T)), + Post(update_c_let(T, Vs, A, B), S3); seq -> - {A, S1} = mapfold(F, S0, seq_arg(T)), - {B, S2} = mapfold(F, S1, seq_body(T)), - F(update_c_seq(T, A, B), S2); + {A, S1} = mapfold(Pre, Post, S0, seq_arg(T)), + {B, S2} = mapfold(Pre, Post, S1, seq_body(T)), + Post(update_c_seq(T, A, B), S2); apply -> - {E, S1} = mapfold(F, S0, apply_op(T)), - {As, S2} = mapfold_list(F, S1, apply_args(T)), - F(update_c_apply(T, E, As), S2); + {E, S1} = mapfold(Pre, Post, S0, apply_op(T)), + {As, S2} = mapfold_list(Pre, Post, S1, apply_args(T)), + Post(update_c_apply(T, E, As), S2); call -> - {M, S1} = mapfold(F, S0, call_module(T)), - {N, S2} = mapfold(F, S1, call_name(T)), - {As, S3} = mapfold_list(F, S2, call_args(T)), - F(update_c_call(T, M, N, As), S3); + {M, S1} = mapfold(Pre, Post, S0, call_module(T)), + {N, S2} = mapfold(Pre, Post, S1, call_name(T)), + {As, S3} = mapfold_list(Pre, Post, S2, call_args(T)), + Post(update_c_call(T, M, N, As), S3); primop -> - {N, S1} = mapfold(F, S0, primop_name(T)), - {As, S2} = mapfold_list(F, S1, primop_args(T)), - F(update_c_primop(T, N, As), S2); + {N, S1} = mapfold(Pre, Post, S0, primop_name(T)), + {As, S2} = mapfold_list(Pre, Post, S1, primop_args(T)), + Post(update_c_primop(T, N, As), S2); 'case' -> - {A, S1} = mapfold(F, S0, case_arg(T)), - {Cs, S2} = mapfold_list(F, S1, case_clauses(T)), - F(update_c_case(T, A, Cs), S2); + {A, S1} = mapfold(Pre, Post, S0, case_arg(T)), + {Cs, S2} = mapfold_list(Pre, Post, S1, case_clauses(T)), + Post(update_c_case(T, A, Cs), S2); clause -> - {Ps, S1} = mapfold_list(F, S0, clause_pats(T)), - {G, S2} = mapfold(F, S1, clause_guard(T)), - {B, S3} = mapfold(F, S2, clause_body(T)), - F(update_c_clause(T, Ps, G, B), S3); + {Ps, S1} = mapfold_list(Pre, Post, S0, clause_pats(T)), + {G, S2} = mapfold(Pre, Post, S1, clause_guard(T)), + {B, S3} = mapfold(Pre, Post, S2, clause_body(T)), + Post(update_c_clause(T, Ps, G, B), S3); alias -> - {V, S1} = mapfold(F, S0, alias_var(T)), - {P, S2} = mapfold(F, S1, alias_pat(T)), - F(update_c_alias(T, V, P), S2); + {V, S1} = mapfold(Pre, Post, S0, alias_var(T)), + {P, S2} = mapfold(Pre, Post, S1, alias_pat(T)), + Post(update_c_alias(T, V, P), S2); 'fun' -> - {Vs, S1} = mapfold_list(F, S0, fun_vars(T)), - {B, S2} = mapfold(F, S1, fun_body(T)), - F(update_c_fun(T, Vs, B), S2); + {Vs, S1} = mapfold_list(Pre, Post, S0, fun_vars(T)), + {B, S2} = mapfold(Pre, Post, S1, fun_body(T)), + Post(update_c_fun(T, Vs, B), S2); 'receive' -> - {Cs, S1} = mapfold_list(F, S0, receive_clauses(T)), - {E, S2} = mapfold(F, S1, receive_timeout(T)), - {A, S3} = mapfold(F, S2, receive_action(T)), - F(update_c_receive(T, Cs, E, A), S3); + {Cs, S1} = mapfold_list(Pre, Post, S0, receive_clauses(T)), + {E, S2} = mapfold(Pre, Post, S1, receive_timeout(T)), + {A, S3} = mapfold(Pre, Post, S2, receive_action(T)), + Post(update_c_receive(T, Cs, E, A), S3); 'try' -> - {E, S1} = mapfold(F, S0, try_arg(T)), - {Vs, S2} = mapfold_list(F, S1, try_vars(T)), - {B, S3} = mapfold(F, S2, try_body(T)), - {Evs, S4} = mapfold_list(F, S3, try_evars(T)), - {H, S5} = mapfold(F, S4, try_handler(T)), - F(update_c_try(T, E, Vs, B, Evs, H), S5); + {E, S1} = mapfold(Pre, Post, S0, try_arg(T)), + {Vs, S2} = mapfold_list(Pre, Post, S1, try_vars(T)), + {B, S3} = mapfold(Pre, Post, S2, try_body(T)), + {Evs, S4} = mapfold_list(Pre, Post, S3, try_evars(T)), + {H, S5} = mapfold(Pre, Post, S4, try_handler(T)), + Post(update_c_try(T, E, Vs, B, Evs, H), S5); 'catch' -> - {B, S1} = mapfold(F, S0, catch_body(T)), - F(update_c_catch(T, B), S1); + {B, S1} = mapfold(Pre, Post, S0, catch_body(T)), + Post(update_c_catch(T, B), S1); binary -> - {Ds, S1} = mapfold_list(F, S0, binary_segments(T)), - F(update_c_binary(T, Ds), S1); + {Ds, S1} = mapfold_list(Pre, Post, S0, binary_segments(T)), + Post(update_c_binary(T, Ds), S1); bitstr -> - {Val, S1} = mapfold(F, S0, bitstr_val(T)), - {Size, S2} = mapfold(F, S1, bitstr_size(T)), - {Unit, S3} = mapfold(F, S2, bitstr_unit(T)), - {Type, S4} = mapfold(F, S3, bitstr_type(T)), - {Flags, S5} = mapfold(F, S4, bitstr_flags(T)), - F(update_c_bitstr(T, Val, Size, Unit, Type, Flags), S5); + {Val, S1} = mapfold(Pre, Post, S0, bitstr_val(T)), + {Size, S2} = mapfold(Pre, Post, S1, bitstr_size(T)), + {Unit, S3} = mapfold(Pre, Post, S2, bitstr_unit(T)), + {Type, S4} = mapfold(Pre, Post, S3, bitstr_type(T)), + {Flags, S5} = mapfold(Pre, Post, S4, bitstr_flags(T)), + Post(update_c_bitstr(T, Val, Size, Unit, Type, Flags), S5); letrec -> - {Ds, S1} = mapfold_pairs(F, S0, letrec_defs(T)), - {B, S2} = mapfold(F, S1, letrec_body(T)), - F(update_c_letrec(T, Ds, B), S2); + {Ds, S1} = mapfold_pairs(Pre, Post, S0, letrec_defs(T)), + {B, S2} = mapfold(Pre, Post, S1, letrec_body(T)), + Post(update_c_letrec(T, Ds, B), S2); module -> - {N, S1} = mapfold(F, S0, module_name(T)), - {Es, S2} = mapfold_list(F, S1, module_exports(T)), - {As, S3} = mapfold_pairs(F, S2, module_attrs(T)), - {Ds, S4} = mapfold_pairs(F, S3, module_defs(T)), - F(update_c_module(T, N, Es, As, Ds), S4) + {N, S1} = mapfold(Pre, Post, S0, module_name(T)), + {Es, S2} = mapfold_list(Pre, Post, S1, module_exports(T)), + {As, S3} = mapfold_pairs(Pre, Post, S2, module_attrs(T)), + {Ds, S4} = mapfold_pairs(Pre, Post, S3, module_defs(T)), + Post(update_c_module(T, N, Es, As, Ds), S4) end. -mapfold_list(F, S0, [T | Ts]) -> - {T1, S1} = mapfold(F, S0, T), - {Ts1, S2} = mapfold_list(F, S1, Ts), +mapfold_list(Pre, Post, S0, [T | Ts]) -> + {T1, S1} = mapfold(Pre, Post, S0, T), + {Ts1, S2} = mapfold_list(Pre, Post, S1, Ts), {[T1 | Ts1], S2}; -mapfold_list(_, S, []) -> +mapfold_list(_, _, S, []) -> {[], S}. -mapfold_pairs(F, S0, [{T1, T2} | Ps]) -> - {T3, S1} = mapfold(F, S0, T1), - {T4, S2} = mapfold(F, S1, T2), - {Ps1, S3} = mapfold_pairs(F, S2, Ps), +mapfold_pairs(Pre, Post, S0, [{T1, T2} | Ps]) -> + {T3, S1} = mapfold(Pre, Post, S0, T1), + {T4, S2} = mapfold(Pre, Post, S1, T2), + {Ps1, S3} = mapfold_pairs(Pre, Post, S2, Ps), {[{T3, T4} | Ps1], S3}; -mapfold_pairs(_, S, []) -> +mapfold_pairs(_, _, S, []) -> {[], S}. @@ -640,8 +666,8 @@ vars_in_list([], _, A) -> vars_in_defs(Ds, S) -> vars_in_defs(Ds, S, []). -vars_in_defs([{_, F} | Ds], S, A) -> - vars_in_defs(Ds, S, ordsets:union(variables(F, S), A)); +vars_in_defs([{_, Post} | Ds], S, A) -> + vars_in_defs(Ds, S, ordsets:union(variables(Post, S), A)); vars_in_defs([], _, A) -> A. @@ -703,13 +729,14 @@ label(T, N, Env) -> %% Constant literals are not labeled. {T, N}; var -> - case dict:find(var_name(T), Env) of - {ok, L} -> - {As, _} = label_ann(T, L), - N1 = N; - error -> - {As, N1} = label_ann(T, N) - end, + {As, N1} = + case dict:find(var_name(T), Env) of + {ok, L} -> + {A, _} = label_ann(T, L), + {A, N}; + error -> + label_ann(T, N) + end, {set_ann(T, As), N1}; values -> {Ts, N1} = label_list(values_es(T), N, Env), diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index e0a29fe9b1..46917905de 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -40,6 +40,8 @@ %%---------------------------------------------------------------------- +-type abstract_code() :: [erl_parse:abstract_form()]. + -type option() :: atom() | {atom(), term()} | {'d', atom(), term()}. -type err_info() :: {erl_anno:line() | 'none', @@ -48,6 +50,9 @@ -type warnings() :: [{file:filename(), [err_info()]}]. -type mod_ret() :: {'ok', module()} | {'ok', module(), cerl:c_module()} %% with option 'to_core' + | {'ok', %% with option 'to_pp' + module() | [], %% module() if 'to_exp' + abstract_code()} | {'ok', module(), warnings()}. -type bin_ret() :: {'ok', module(), binary()} | {'ok', module(), binary(), warnings()}. @@ -78,7 +83,11 @@ file(File, Opts) when is_list(Opts) -> file(File, Opt) -> file(File, [Opt|?DEFAULT_OPTIONS]). -forms(File) -> forms(File, ?DEFAULT_OPTIONS). +-spec forms(abstract_code()) -> comp_ret(). + +forms(Forms) -> forms(Forms, ?DEFAULT_OPTIONS). + +-spec forms(abstract_code(), [option()] | option()) -> comp_ret(). forms(Forms, Opts) when is_list(Opts) -> do_compile({forms,Forms}, [binary|Opts++env_default_opts()]); @@ -106,6 +115,8 @@ noenv_file(File, Opts) when is_list(Opts) -> noenv_file(File, Opt) -> noenv_file(File, [Opt|?DEFAULT_OPTIONS]). +-spec noenv_forms(abstract_code(), [option()] | option()) -> comp_ret(). + noenv_forms(Forms, Opts) when is_list(Opts) -> do_compile({forms,Forms}, [binary|Opts]); noenv_forms(Forms, Opt) when is_atom(Opt) -> @@ -671,11 +682,16 @@ asm_passes() -> %% Assembly level optimisations. [{delay, [{pass,beam_a}, + {iff,da,{listing,"a"}}, {unless,no_postopt, - [{pass,beam_block}, + [{unless,no_reorder,{pass,beam_reorder}}, + {iff,dre,{listing,"reorder"}}, + {pass,beam_block}, {iff,dblk,{listing,"block"}}, {unless,no_except,{pass,beam_except}}, {iff,dexcept,{listing,"except"}}, + {unless,no_bs_opt,{pass,beam_bs}}, + {iff,dbs,{listing,"bs"}}, {unless,no_bopt,{pass,beam_bool}}, {iff,dbool,{listing,"bool"}}, {unless,no_topt,{pass,beam_type}}, @@ -703,6 +719,7 @@ asm_passes() -> {iff,no_postopt,[{pass,beam_clean}]}, {pass,beam_z}, + {iff,dz,{listing,"z"}}, {iff,dopt,{listing,"optimize"}}, {iff,'S',{listing,"S"}}, {iff,'to_asm',{done,"S"}}]}, @@ -1300,21 +1317,12 @@ generate_key(String) when is_list(String) -> encrypt({des3_cbc=Type,Key,IVec,BlockSize}, Bin0) -> Bin1 = case byte_size(Bin0) rem BlockSize of 0 -> Bin0; - N -> list_to_binary([Bin0,random_bytes(BlockSize-N)]) + N -> list_to_binary([Bin0,crypto:rand_bytes(BlockSize-N)]) end, Bin = crypto:block_encrypt(Type, Key, IVec, Bin1), TypeString = atom_to_list(Type), list_to_binary([0,length(TypeString),TypeString,Bin]). -random_bytes(N) -> - _ = random:seed(erlang:time_offset(), - erlang:monotonic_time(), - erlang:unique_integer()), - random_bytes_1(N, []). - -random_bytes_1(0, Acc) -> Acc; -random_bytes_1(N, Acc) -> random_bytes_1(N-1, [random:uniform(255)|Acc]). - save_core_code(St) -> {ok,St#compile{core_code=cerl:from_records(St#compile.code)}}. @@ -1612,11 +1620,8 @@ output_encoding(F, #compile{encoding = Encoding}) -> ok = io:setopts(F, [{encoding, Encoding}]), ok = io:fwrite(F, <<"%% ~s\n">>, [epp:encoding_to_string(Encoding)]). -restore_expanded_types("P", Fs) -> - epp:restore_typed_record_fields(Fs); restore_expanded_types("E", {M,I,Fs0}) -> - Fs1 = restore_expand_module(Fs0), - Fs = epp:restore_typed_record_fields(Fs1), + Fs = restore_expand_module(Fs0), {M,I,Fs}; restore_expanded_types(_Ext, Code) -> Code. @@ -1628,6 +1633,8 @@ restore_expand_module([{attribute,Line,spec,[Arg]}|Fs]) -> [{attribute,Line,spec,Arg}|restore_expand_module(Fs)]; restore_expand_module([{attribute,Line,callback,[Arg]}|Fs]) -> [{attribute,Line,callback,Arg}|restore_expand_module(Fs)]; +restore_expand_module([{attribute,Line,record,[R]}|Fs]) -> + [{attribute,Line,record,R}|restore_expand_module(Fs)]; restore_expand_module([F|Fs]) -> [F|restore_expand_module(Fs)]; restore_expand_module([]) -> []. diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src index afb85f4710..a2b2a1d277 100644 --- a/lib/compiler/src/compiler.app.src +++ b/lib/compiler/src/compiler.app.src @@ -25,6 +25,7 @@ beam_asm, beam_block, beam_bool, + beam_bs, beam_bsm, beam_clean, beam_dead, @@ -37,6 +38,7 @@ beam_opcodes, beam_peep, beam_receive, + beam_reorder, beam_split, beam_trim, beam_type, diff --git a/lib/compiler/src/core_lib.erl b/lib/compiler/src/core_lib.erl index 3abb520485..839c736ff2 100644 --- a/lib/compiler/src/core_lib.erl +++ b/lib/compiler/src/core_lib.erl @@ -21,52 +21,16 @@ -module(core_lib). --deprecated({get_anno,1,next_major_release}). --deprecated({set_anno,2,next_major_release}). --deprecated({is_literal,1,next_major_release}). --deprecated({is_literal_list,1,next_major_release}). --deprecated({literal_value,1,next_major_release}). - --export([get_anno/1,set_anno/2]). --export([is_literal/1,is_literal_list/1]). --export([literal_value/1]). -export([make_values/1]). -export([is_var_used/2]). -include("core_parse.hrl"). -%% -%% Generic get/set annotation that should be used only with cerl() structures. -%% --spec get_anno(cerl:cerl()) -> term(). - -get_anno(C) -> cerl:get_ann(C). - --spec set_anno(cerl:cerl(), term()) -> cerl:cerl(). - -set_anno(C, A) -> cerl:set_ann(C, A). - --spec is_literal(cerl:cerl()) -> boolean(). - -is_literal(Cerl) -> - cerl:is_literal(cerl:fold_literal(Cerl)). - --spec is_literal_list([cerl:cerl()]) -> boolean(). - -is_literal_list(Es) -> lists:all(fun is_literal/1, Es). - -%% Return the value of LitExpr. --spec literal_value(cerl:c_literal() | cerl:c_binary() | - cerl:c_map() | cerl:c_cons() | cerl:c_tuple()) -> term(). - -literal_value(Cerl) -> - cerl:concrete(cerl:fold_literal(Cerl)). - %% Make a suitable values structure, expr or values, depending on Expr. -spec make_values([cerl:cerl()] | cerl:cerl()) -> cerl:cerl(). make_values([E]) -> E; -make_values([H|_]=Es) -> #c_values{anno=get_anno(H),es=Es}; +make_values([H|_]=Es) -> #c_values{anno=cerl:get_ann(H),es=Es}; make_values([]) -> #c_values{es=[]}; make_values(E) -> E. diff --git a/lib/compiler/src/core_lint.erl b/lib/compiler/src/core_lint.erl index cc54f6e411..7d3513c0ba 100644 --- a/lib/compiler/src/core_lint.erl +++ b/lib/compiler/src/core_lint.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2013. All Rights Reserved. +%% Copyright Ericsson AB 1999-2015. 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 @@ %% Define the lint state record. -record(lint, {module :: module(), % Current module - func :: fa(), % Current function + func :: fa() | 'undefined', % Current function errors = [] :: [error()], % Errors warnings= [] :: [warning()]}). % Warnings diff --git a/lib/compiler/src/rec_env.erl b/lib/compiler/src/rec_env.erl index 0e9e12d1ad..5a4a870769 100644 --- a/lib/compiler/src/rec_env.erl +++ b/lib/compiler/src/rec_env.erl @@ -598,7 +598,16 @@ start_range(Env) -> %% (pseudo-)randomly distributed over the range. generate(_N, Range) -> - random:uniform(Range). % works well + %% We must use the same sequence of random variables to ensure + %% that two compilations of the same source code generates the + %% same BEAM code. + case rand:export_seed() of + undefined -> + rand:seed(exsplus, {1,42,2053}); + _ -> + ok + end, + rand:uniform(Range). % works well %% ===================================================================== diff --git a/lib/compiler/src/sys_core_dsetel.erl b/lib/compiler/src/sys_core_dsetel.erl index ac32db10fe..c6cfdbae7e 100644 --- a/lib/compiler/src/sys_core_dsetel.erl +++ b/lib/compiler/src/sys_core_dsetel.erl @@ -72,7 +72,7 @@ module(M0, _Options) -> {ok,M}. visit_module(#c_module{defs=Ds0}=R) -> - Env = dict:new(), + Env = #{}, Ds = visit_module_1(Ds0, Env, []), R#c_module{defs=Ds}. @@ -95,9 +95,11 @@ visit(Env, #c_var{name={_,_}}=R) -> {R, Env}; visit(Env0, #c_var{name=X}=R) -> %% There should not be any free variables. If there are, - %% the next line will cause an exception. - {ok, N} = dict:find(X, Env0), - {R, dict:store(X, N+1, Env0)}; + %% the case will fail with an exception. + case Env0 of + #{X:=N} -> + {R, Env0#{X:=N+1}} + end; visit(Env, #c_literal{}=R) -> {R, Env}; visit(Env0, #c_tuple{es=Es0}=R) -> @@ -203,7 +205,7 @@ bind_vars(Vs, Env) -> bind_vars(Vs, Env, []). bind_vars([#c_var{name=X}|Vs], Env0, Xs)-> - bind_vars(Vs, dict:store(X, 0, Env0), [X|Xs]); + bind_vars(Vs, Env0#{X=>0}, [X|Xs]); bind_vars([], Env,Xs) -> {Xs, Env}. @@ -217,7 +219,7 @@ visit_pats([], Env, Vs) -> {Vs, Env}. visit_pat(Env0, #c_var{name=V}, Vs) -> - {[V|Vs], dict:store(V, 0, Env0)}; + {[V|Vs], Env0#{V=>0}}; visit_pat(Env0, #c_tuple{es=Es}, Vs) -> visit_pats(Es, Env0, Vs); visit_pat(Env0, #c_map{es=Es}, Vs) -> @@ -235,23 +237,25 @@ visit_pat(Env0, #c_bitstr{val=Val,size=Sz}, Vs0) -> case Sz of #c_var{name=V} -> %% We don't tolerate free variables. - {ok, N} = dict:find(V, Env0), - {Vs0, dict:store(V, N+1, Env0)}; + case Env0 of + #{V:=N} -> + {Vs0, Env0#{V:=N+1}} + end; _ -> visit_pat(Env0, Sz, Vs0) end, visit_pat(Env1, Val, Vs1); visit_pat(Env0, #c_alias{pat=P,var=#c_var{name=V}}, Vs) -> - visit_pat(dict:store(V, 0, Env0), P, [V|Vs]); + visit_pat(Env0#{V=>0}, P, [V|Vs]); visit_pat(Env, #c_literal{}, Vs) -> {Vs, Env}. restore_vars([V|Vs], Env0, Env1) -> - case dict:find(V, Env0) of - {ok, N} -> - restore_vars(Vs, Env0, dict:store(V, N, Env1)); - error -> - restore_vars(Vs, Env0, dict:erase(V, Env1)) + case Env0 of + #{V:=N} -> + restore_vars(Vs, Env0, Env1#{V=>N}); + _ -> + restore_vars(Vs, Env0, maps:remove(V, Env1)) end; restore_vars([], _, Env1) -> Env1. @@ -349,8 +353,8 @@ is_safe(#c_literal{}) -> true; is_safe(_) -> false. is_single_use(V, Env) -> - case dict:find(V, Env) of - {ok, 1} -> + case Env of + #{V:=1} -> true; _ -> false diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index 65699ccda9..43ce9a7172 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -2793,12 +2793,18 @@ extract_type_1(Expr, Sub) -> 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('div', [_,_]) -> 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; diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl index d9cc4b530c..7ab4e1845c 100644 --- a/lib/compiler/src/sys_pre_expand.erl +++ b/lib/compiler/src/sys_pre_expand.erl @@ -29,30 +29,26 @@ %% Main entry point. -export([module/2]). --import(ordsets, [from_list/1,union/2]). -import(lists, [member/2,foldl/3,foldr/3]). --include("../include/erl_bits.hrl"). - -type fa() :: {atom(), arity()}. -record(expand, {module=[], %Module name exports=[], %Exports - imports=[], %Imports attributes=[], %Attributes callbacks=[], %Callbacks optional_callbacks=[] :: [fa()], %Optional callbacks - defined, %Defined functions (gb_set) vcount=0, %Variable counter func=[], %Current function arity=[], %Arity for current function - fcount=0 %Local fun count + fcount=0, %Local fun count + ctype %Call type map }). %% module(Forms, CompileOptions) %% {ModuleName,Exports,TransformedForms,CompileOptions'} -%% Expand the forms in one module. N.B.: the lists of predefined -%% exports and imports are really ordsets! +%% Expand the forms in one module. +%% %% CompileOptions is augmented with options from -compile attributes. module(Fs0, Opts0) -> @@ -65,19 +61,28 @@ module(Fs0, Opts0) -> %% Set pre-defined exported functions. PreExp = [{module_info,0},{module_info,1}], + %% Build the set of defined functions and the initial call + %% type map. + Defined = defined_functions(Fs, PreExp), + Ctype = maps:from_list([{K,local} || K <- Defined]), + %% Build initial expand record. St0 = #expand{exports=PreExp, - defined=PreExp + ctype=Ctype }, + %% Expand the functions. - {Tfs,St1} = forms(Fs, define_functions(Fs, St0)), + {Tfs,St1} = forms(Fs, St0), + %% Get the correct list of exported functions. Exports = case member(export_all, Opts) of - true -> gb_sets:to_list(St1#expand.defined); + true -> Defined; false -> St1#expand.exports end, + St2 = St1#expand{exports=Exports,ctype=undefined}, + %% Generate all functions from stored info. - {Ats,St3} = module_attrs(St1#expand{exports = Exports}), + {Ats,St3} = module_attrs(St2), {Mfs,St4} = module_predef_funcs(St3), {St4#expand.module, St4#expand.exports, Ats ++ Tfs ++ Mfs, Opts}. @@ -85,14 +90,14 @@ module(Fs0, Opts0) -> compiler_options(Forms) -> lists:flatten([C || {attribute,_,compile,C} <- Forms]). -%% define_function(Form, State) -> State. +%% defined_function(Forms, Predef) -> Functions. %% Add function to defined if form is a function. -define_functions(Forms, #expand{defined=Predef}=St) -> +defined_functions(Forms, Predef) -> Fs = foldl(fun({function,_,N,A,_Cs}, Acc) -> [{N,A}|Acc]; (_, Acc) -> Acc end, Predef, Forms), - St#expand{defined=gb_sets:from_list(Fs)}. + ordsets:from_list(Fs). module_attrs(#expand{attributes=Attributes}=St) -> Attrs = [{attribute,Line,Name,Val} || {Name,Line,Val} <- Attributes], @@ -113,23 +118,21 @@ is_fa_list([{FuncName, Arity}|L]) is_fa_list([]) -> true; is_fa_list(_) -> false. -module_predef_funcs(St) -> - {Mpf1,St1}=module_predef_func_beh_info(St), - {Mpf2,St2}=module_predef_funcs_mod_info(St1), +module_predef_funcs(St0) -> + {Mpf1,St1} = module_predef_func_beh_info(St0), + Mpf2 = module_predef_funcs_mod_info(St1), Mpf = [erl_parse:new_anno(F) || F <- Mpf1++Mpf2], - {Mpf,St2}. + {Mpf,St1}. module_predef_func_beh_info(#expand{callbacks=[]}=St) -> {[], St}; module_predef_func_beh_info(#expand{callbacks=Callbacks, optional_callbacks=OptionalCallbacks, - defined=Defined, exports=Exports}=St) -> - PreDef=[{behaviour_info,1}], - PreExp=PreDef, + PreDef0 = [{behaviour_info,1}], + PreDef = ordsets:from_list(PreDef0), {[gen_beh_info(Callbacks, OptionalCallbacks)], - St#expand{defined=gb_sets:union(gb_sets:from_list(PreDef), Defined), - exports=union(from_list(PreExp), Exports)}}. + St#expand{exports=ordsets:union(PreDef, Exports)}}. gen_beh_info(Callbacks, OptionalCallbacks) -> List = make_list(Callbacks), @@ -156,20 +159,16 @@ make_optional_list([{Name,Arity}|Rest]) -> {integer,0,Arity}]}, make_optional_list(Rest)}. -module_predef_funcs_mod_info(St) -> - PreDef = [{module_info,0},{module_info,1}], - PreExp = PreDef, - {[{function,0,module_info,0, - [{clause,0,[],[], +module_predef_funcs_mod_info(#expand{module=Mod}) -> + ModAtom = {atom,0,Mod}, + [{function,0,module_info,0, + [{clause,0,[],[], [{call,0,{remote,0,{atom,0,erlang},{atom,0,get_module_info}}, - [{atom,0,St#expand.module}]}]}]}, - {function,0,module_info,1, - [{clause,0,[{var,0,'X'}],[], + [ModAtom]}]}]}, + {function,0,module_info,1, + [{clause,0,[{var,0,'X'}],[], [{call,0,{remote,0,{atom,0,erlang},{atom,0,get_module_info}}, - [{atom,0,St#expand.module},{var,0,'X'}]}]}]}], - St#expand{defined=gb_sets:union(gb_sets:from_list(PreDef), - St#expand.defined), - exports=union(from_list(PreExp), St#expand.exports)}}. + [ModAtom,{var,0,'X'}]}]}]}]. %% forms(Forms, State) -> %% {TransformedForms,State'} @@ -196,7 +195,8 @@ attribute(module, Module, _L, St) -> true = is_atom(Module), St#expand{module=Module}; attribute(export, Es, _L, St) -> - St#expand{exports=union(from_list(Es), St#expand.exports)}; + St#expand{exports=ordsets:union(ordsets:from_list(Es), + St#expand.exports)}; attribute(import, Is, _L, St) -> import(Is, St); attribute(compile, _C, _L, St) -> @@ -231,8 +231,6 @@ head(As, St) -> pattern_list(As, St). %% {TransformedPattern,State'} %% -pattern({var,_,'_'}=Var, St) -> %Ignore anonymous variable. - {Var,St}; pattern({var,_,_}=Var, St) -> {Var,St}; pattern({char,_,_}=Char, St) -> @@ -385,19 +383,19 @@ expr({block,Line,Es0}, St0) -> {Es,St1} = exprs(Es0, St0), {{block,Line,Es},St1}; expr({'if',Line,Cs0}, St0) -> - {Cs,St1} = icr_clauses(Cs0, St0), + {Cs,St1} = clauses(Cs0, St0), {{'if',Line,Cs},St1}; expr({'case',Line,E0,Cs0}, St0) -> {E,St1} = expr(E0, St0), - {Cs,St2} = icr_clauses(Cs0, St1), + {Cs,St2} = clauses(Cs0, St1), {{'case',Line,E,Cs},St2}; expr({'receive',Line,Cs0}, St0) -> - {Cs,St1} = icr_clauses(Cs0, St0), + {Cs,St1} = clauses(Cs0, St0), {{'receive',Line,Cs},St1}; expr({'receive',Line,Cs0,To0,ToEs0}, St0) -> {To,St1} = expr(To0, St0), {ToEs,St2} = exprs(ToEs0, St1), - {Cs,St3} = icr_clauses(Cs0, St2), + {Cs,St3} = clauses(Cs0, St2), {{'receive',Line,Cs,To,ToEs},St3}; expr({'fun',Line,Body}, St) -> fun_tq(Line, Body, St); @@ -406,21 +404,15 @@ expr({named_fun,Line,Name,Cs}, St) -> expr({call,Line,{atom,La,N}=Atom,As0}, St0) -> {As,St1} = expr_list(As0, St0), Ar = length(As), - case defined(N,Ar,St1) of - true -> + Key = {N,Ar}, + case St1#expand.ctype of + #{Key:=local} -> {{call,Line,Atom,As},St1}; + #{Key:={imported,Mod}} -> + {{call,Line,{remote,La,{atom,La,Mod},Atom},As},St1}; _ -> - case imported(N, Ar, St1) of - {yes,Mod} -> - {{call,Line,{remote,La,{atom,La,Mod},Atom},As},St1}; - no -> - case erl_internal:bif(N, Ar) of - true -> - {{call,Line,{remote,La,{atom,La,erlang},Atom},As},St1}; - false -> %% This should have been handled by erl_lint - {{call,Line,Atom,As},St1} - end - end + true = erl_internal:bif(N, Ar), + {{call,Line,{remote,La,{atom,La,erlang},Atom},As},St1} end; expr({call,Line,{remote,Lr,M0,F},As0}, St0) -> {[M1,F1|As1],St1} = expr_list([M0,F|As0], St0), @@ -430,12 +422,11 @@ expr({call,Line,F,As0}, St0) -> {{call,Line,Fun1,As1},St1}; expr({'try',Line,Es0,Scs0,Ccs0,As0}, St0) -> {Es1,St1} = exprs(Es0, St0), - {Scs1,St2} = icr_clauses(Scs0, St1), - {Ccs1,St3} = icr_clauses(Ccs0, St2), + {Scs1,St2} = clauses(Scs0, St1), + {Ccs1,St3} = clauses(Ccs0, St2), {As1,St4} = exprs(As0, St3), {{'try',Line,Es1,Scs1,Ccs1,As1},St4}; expr({'catch',Line,E0}, St0) -> - %% Catch exports no new variables. {E,St1} = expr(E0, St0), {{'catch',Line,E},St1}; expr({match,Line,P0,E0}, St0) -> @@ -456,21 +447,6 @@ expr_list([E0|Es0], St0) -> {[E|Es],St2}; expr_list([], St) -> {[],St}. -%% icr_clauses([Clause], State) -> {[TransformedClause],State'} -%% Be very careful here to return the variables that are really used -%% and really new. - -icr_clauses([], St) -> {[],St}; -icr_clauses(Clauses, St) -> icr_clauses2(Clauses, St). - -icr_clauses2([{clause,Line,H0,G0,B0}|Cs0], St0) -> - {H,St1} = head(H0, St0), - {G,St2} = guard(G0, St1), - {B,St3} = exprs(B0, St2), - {Cs,St4} = icr_clauses2(Cs0, St3), - {[{clause,Line,H,G,B}|Cs],St4}; -icr_clauses2([], St) -> {[],St}. - %% lc_tq(Line, Qualifiers, State) -> %% {[TransQual],State'} @@ -486,16 +462,9 @@ lc_tq(Line, [{b_generate,Lg,P0,G0}|Qs0], St0) -> {Qs1,St3} = lc_tq(Line, Qs0, St2), {[{b_generate,Lg,P1,G1}|Qs1],St3}; lc_tq(Line, [F0 | Qs0], St0) -> - case erl_lint:is_guard_test(F0) of - true -> - {F1,St1} = guard_test(F0, St0), - {Qs1,St2} = lc_tq(Line, Qs0, St1), - {[F1|Qs1],St2}; - false -> - {F1,St1} = expr(F0, St0), - {Qs1,St2} = lc_tq(Line, Qs0, St1), - {[F1 | Qs1],St2} - end; + {F1,St1} = expr(F0, St0), + {Qs1,St2} = lc_tq(Line, Qs0, St1), + {[F1|Qs1],St2}; lc_tq(_Line, [], St0) -> {[],St0}. @@ -527,7 +496,7 @@ fun_tq(L, {function,M,F,A}, St) when is_atom(M), is_atom(F), is_integer(A) -> fun_tq(Lf, {function,_,_,_}=ExtFun, St) -> {{'fun',Lf,ExtFun},St}; fun_tq(Lf, {clauses,Cs0}, St0) -> - {Cs1,St1} = fun_clauses(Cs0, St0), + {Cs1,St1} = clauses(Cs0, St0), {Fname,St2} = new_fun_name(St1), %% Set dummy values for Index and Uniq -- the real values will %% be assigned by beam_asm. @@ -535,18 +504,10 @@ fun_tq(Lf, {clauses,Cs0}, St0) -> {{'fun',Lf,{clauses,Cs1},{Index,Uniq,Fname}},St2}. fun_tq(Line, Cs0, St0, Name) -> - {Cs1,St1} = fun_clauses(Cs0, St0), + {Cs1,St1} = clauses(Cs0, St0), {Fname,St2} = new_fun_name(St1, Name), {{named_fun,Line,Name,Cs1,{0,0,Fname}},St2}. -fun_clauses([{clause,L,H0,G0,B0}|Cs0], St0) -> - {H,St1} = head(H0, St0), - {G,St2} = guard(G0, St1), - {B,St3} = exprs(B0, St2), - {Cs,St4} = fun_clauses(Cs0, St3), - {[{clause,L,H,G,B}|Cs],St4}; -fun_clauses([], St) -> {[],St}. - %% new_fun_name(State) -> {FunName,State}. new_fun_name(St) -> @@ -571,7 +532,6 @@ pattern_element({bin_element,Line,Expr0,Size0,Type0}, {Es,St0}) -> {[{bin_element,Line,Expr,Size,Type}|Es],St2}. pat_bit_size(default, St) -> {default,St}; -pat_bit_size({atom,_La,all}=All, St) -> {All,St}; pat_bit_size({var,_Lv,_V}=Var, St) -> {Var,St}; pat_bit_size(Size, St) -> Line = element(2, Size), @@ -592,8 +552,7 @@ coerce_to_float({integer,L,I}=E, [float|_]) -> try {float,L,float(I)} catch - error:badarg -> E; - error:badarith -> E + error:badarg -> E end; coerce_to_float(E, _) -> E. @@ -647,25 +606,11 @@ string_to_conses(Line, Cs, Tail) -> %% import(Line, Imports, State) -> %% State' -%% imported(Name, Arity, State) -> -%% {yes,Module} | no -%% Handle import declarations and test for imported functions. No need to -%% check when building imports as code is correct. +%% Handle import declarations. -import({Mod,Fs}, St) -> +import({Mod,Fs}, #expand{ctype=Ctype0}=St) -> true = is_atom(Mod), - Mfs = from_list(Fs), - St#expand{imports=add_imports(Mod, Mfs, St#expand.imports)}. - -add_imports(Mod, [F|Fs], Is) -> - add_imports(Mod, Fs, orddict:store(F, Mod, Is)); -add_imports(_, [], Is) -> Is. - -imported(F, A, St) -> - case orddict:find({F,A}, St#expand.imports) of - {ok,Mod} -> {yes,Mod}; - error -> no - end. - -defined(F, A, St) -> - gb_sets:is_element({F,A}, St#expand.defined). + Ctype = foldl(fun(F, A) -> + A#{F=>{imported,Mod}} + end, Ctype0, Fs), + St#expand{ctype=Ctype}. diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index 34c67b16ca..6f1912c616 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -827,21 +827,24 @@ select_extract_bin([{var,Hd},{var,Tl}], Size0, Unit, Type, Flags, Vf, {bs_save2,CtxReg,{Ctx,Tl}}],Int1} end, {Es,clear_dead(Aft, I, Vdb),St}; -select_extract_bin([{var,Hd}], Size0, Unit, binary, Flags, Vf, +select_extract_bin([{var,Hd}], Size, Unit, binary, Flags, Vf, I, Vdb, Bef, Ctx, Body, St) -> - SizeReg = get_bin_size_reg(Size0, Bef), + %% Match the last segment of a binary. We KNOW that the size + %% must be 'all'. + Size = {atom,all}, %Assertion. {Es,Aft} = case vdb_find(Hd, Vdb) of {_,_,Lhd} when Lhd =< I -> + %% The result will not be used. Furthermore, since we + %% we are at the end of the binary, the position will + %% not be used again; thus, it is safe to do a cheaper + %% test of the unit. CtxReg = fetch_var(Ctx, Bef), - {case SizeReg =:= {atom,all} andalso is_context_unused(Body) of - true when Unit =:= 1 -> + {case Unit of + 1 -> []; - true -> - [{test,bs_test_unit,{f,Vf},[CtxReg,Unit]}]; - false -> - [{test,bs_skip_bits2,{f,Vf}, - [CtxReg,SizeReg,Unit,{field_flags,Flags}]}] + _ -> + [{test,bs_test_unit,{f,Vf},[CtxReg,Unit]}] end,Bef}; {_,_,_} -> case is_context_unused(Body) of @@ -853,7 +856,7 @@ select_extract_bin([{var,Hd}], Size0, Unit, binary, Flags, Vf, Name = bs_get_binary2, Live = max_reg(Bef#sr.reg), {[{test,Name,{f,Vf},Live, - [CtxReg,SizeReg,Unit,{field_flags,Flags}],Rhd}], + [CtxReg,Size,Unit,{field_flags,Flags}],Rhd}], Int1}; true -> %% Since the matching context will not be used again, @@ -868,7 +871,7 @@ select_extract_bin([{var,Hd}], Size0, Unit, binary, Flags, Vf, Name = bs_get_binary2, Live = max_reg(Int1#sr.reg), {[{test,Name,{f,Vf},Live, - [CtxReg,SizeReg,Unit,{field_flags,Flags}],CtxReg}], + [CtxReg,Size,Unit,{field_flags,Flags}],CtxReg}], Int1} end end, @@ -1327,12 +1330,13 @@ bif_cg(Bif, As, [{var,V}], Le, Vdb, Bef, St0) -> %% that we save any variable that will be live after this BIF call. MayFail = not erl_bifs:is_safe(erlang, Bif, length(As)), - {Sis,Int0} = case St0#cg.in_catch andalso - St0#cg.bfail =:= 0 andalso - MayFail of - true -> adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb); - false -> {[],Bef} - end, + {Sis,Int0} = + case MayFail of + true -> + maybe_adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb, St0); + false -> + {[],Bef} + end, Int1 = clear_dead(Int0, Le#l.i, Vdb), Reg = put_reg(V, Int1#sr.reg), Int = Int1#sr{reg=Reg}, @@ -1363,11 +1367,7 @@ gc_bif_cg(Bif, As, [{var,V}], Le, Vdb, Bef, St0) -> %% Currently, we are somewhat pessimistic in %% that we save any variable that will be live after this BIF call. - {Sis,Int0} = - case St0#cg.in_catch andalso St0#cg.bfail =:= 0 of - true -> adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb); - false -> {[],Bef} - end, + {Sis,Int0} = maybe_adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb, St0), Int1 = clear_dead(Int0, Le#l.i, Vdb), Reg = put_reg(V, Int1#sr.reg), @@ -1512,8 +1512,7 @@ set_cg([{var,R}], {cons,Es}, Le, Vdb, Bef, St) -> Int1 = Int0#sr{reg=put_reg(R, Int0#sr.reg)}, Ret = fetch_reg(R, Int1#sr.reg), {[{put_list,S1,S2,Ret}], Int1, St}; -set_cg([{var,R}], {binary,Segs}, Le, Vdb, Bef, - #cg{in_catch=InCatch, bfail=Bfail}=St) -> +set_cg([{var,R}], {binary,Segs}, Le, Vdb, Bef, #cg{bfail=Bfail}=St) -> %% At run-time, binaries are constructed in three stages: %% 1) First the size of the binary is calculated. %% 2) Then the binary is allocated. @@ -1532,11 +1531,7 @@ set_cg([{var,R}], {binary,Segs}, Le, Vdb, Bef, %% First generate the code that constructs each field. Fail = {f,Bfail}, PutCode = cg_bin_put(Segs, Fail, Bef), - {Sis,Int1} = - case InCatch of - true -> adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb); - false -> {[],Int0} - end, + {Sis,Int1} = maybe_adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb, St), MaxRegs = max_reg(Bef#sr.reg), Aft = clear_dead(Int1, Le#l.i, Vdb), @@ -1545,14 +1540,11 @@ set_cg([{var,R}], {binary,Segs}, Le, Vdb, Bef, {Sis++Code,Aft,St}; % Map single variable key set_cg([{var,R}], {map,Op,Map,[{map_pair,{var,_}=K,V}]}, Le, Vdb, Bef, - #cg{in_catch=InCatch,bfail=Bfail}=St) -> + #cg{bfail=Bfail}=St) -> Fail = {f,Bfail}, - {Sis,Int0} = - case InCatch of - true -> adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb); - false -> {[],Bef} - end, + {Sis,Int0} = maybe_adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb, St), + SrcReg = cg_reg_arg(Map,Int0), Line = line(Le#l.a), @@ -1573,17 +1565,13 @@ set_cg([{var,R}], {map,Op,Map,[{map_pair,{var,_}=K,V}]}, Le, Vdb, Bef, % Map (possibly) multiple literal keys set_cg([{var,R}], {map,Op,Map,Es}, Le, Vdb, Bef, - #cg{in_catch=InCatch,bfail=Bfail}=St) -> + #cg{bfail=Bfail}=St) -> %% assert key literals [] = [Var||{map_pair,{var,_}=Var,_} <- Es], Fail = {f,Bfail}, - {Sis,Int0} = - case InCatch of - true -> adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb); - false -> {[],Bef} - end, + {Sis,Int0} = maybe_adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb, St), SrcReg = cg_reg_arg(Map,Int0), Line = line(Le#l.a), @@ -2038,6 +2026,19 @@ trim_free([R|Rs0]) -> end; trim_free([]) -> []. +%% maybe_adjust_stack(Bef, FirstBefore, LastFrom, Vdb, St) -> {[Ainstr],Aft}. +%% Adjust the stack, but only if the code is inside a catch and not +%% inside a guard. Use this funtion before instructions that may +%% cause an exception. + +maybe_adjust_stack(Bef, Fb, Lf, Vdb, St) -> + case St of + #cg{in_catch=true,bfail=0} -> + adjust_stack(Bef, Fb, Lf, Vdb); + #cg{} -> + {[],Bef} + end. + %% adjust_stack(Bef, FirstBefore, LastFrom, Vdb) -> {[Ainstr],Aft}. %% Do complete stack adjustment by compressing stack and adding %% variables to be saved. Try to optimise ordering on stack by diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index 0941ad5dd5..72649e5c9f 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -469,7 +469,8 @@ unforce_tree([#iset{var=#c_var{name=V},arg=Arg0}|Es], D0) -> unforce_tree(Es, D); unforce_tree([#icall{}=Call], D) -> unforce_tree_subst(Call, D); -unforce_tree([Top], _) -> Top. +unforce_tree([#c_var{name=V}], D) -> + gb_trees:get(V, D). unforce_tree_subst(#icall{module=#c_literal{val=erlang}, name=#c_literal{val='=:='}, @@ -804,7 +805,7 @@ map_op(map_field_assoc) -> #c_literal{val=assoc}; map_op(map_field_exact) -> #c_literal{val=exact}. is_valid_map_src(#c_literal{val = M}) when is_map(M) -> true; -is_valid_map_src(#c_var{}) -> true; +is_valid_map_src(#c_var{}=Var) -> not cerl:is_c_fname(Var); is_valid_map_src(_) -> false. %% try_exception([ExcpClause], St) -> {[ExcpVar],Handler,St}. @@ -1852,27 +1853,22 @@ uguard(Pg, Gs0, Ks, St0) -> %% uexprs([Kexpr], [KnownVar], State) -> {[Kexpr],State}. uexprs([#imatch{anno=A,pat=P0,arg=Arg,fc=Fc}|Les], Ks, St0) -> - %% Optimise for simple set of unbound variable. - case upattern(P0, Ks, St0) of - {#c_var{},[],_Pvs,_Pus,_} -> - %% Throw our work away and just set to iset. + case upat_is_new_var(P0, Ks) of + true -> + %% Assignment to a new variable. uexprs([#iset{var=P0,arg=Arg}|Les], Ks, St0); - _Other -> - %% Throw our work away and set to icase. - if - Les =:= [] -> - %% Need to explicitly return match "value", make - %% safe for efficiency. - {La0,Lps,St1} = force_safe(Arg, St0), - La = mark_compiler_generated(La0), - Mc = #iclause{anno=A,pats=[P0],guard=[],body=[La]}, - uexprs(Lps ++ [#icase{anno=A, - args=[La0],clauses=[Mc],fc=Fc}], Ks, St1); - true -> - Mc = #iclause{anno=A,pats=[P0],guard=[],body=Les}, - uexprs([#icase{anno=A,args=[Arg], - clauses=[Mc],fc=Fc}], Ks, St0) - end + false when Les =:= [] -> + %% Need to explicitly return match "value", make + %% safe for efficiency. + {La0,Lps,St1} = force_safe(Arg, St0), + La = mark_compiler_generated(La0), + Mc = #iclause{anno=A,pats=[P0],guard=[],body=[La]}, + uexprs(Lps ++ [#icase{anno=A, + args=[La0],clauses=[Mc],fc=Fc}], Ks, St1); + false -> + Mc = #iclause{anno=A,pats=[P0],guard=[],body=Les}, + uexprs([#icase{anno=A,args=[Arg], + clauses=[Mc],fc=Fc}], Ks, St0) end; uexprs([Le0|Les0], Ks, St0) -> {Le1,St1} = uexpr(Le0, Ks, St0), @@ -1880,6 +1876,15 @@ uexprs([Le0|Les0], Ks, St0) -> {[Le1|Les1],St2}; uexprs([], _, St) -> {[],St}. +%% upat_is_new_var(Pattern, [KnownVar]) -> true|false. +%% Test whether the pattern is a single, previously unknown +%% variable. + +upat_is_new_var(#c_var{name=V}, Ks) -> + not is_element(V, Ks); +upat_is_new_var(_, _) -> + false. + %% Mark a "safe" as compiler-generated. mark_compiler_generated(#c_cons{anno=A,hd=H,tl=T}) -> ann_c_cons([compiler_generated|A], mark_compiler_generated(H), diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index 7ee564683b..4446d5ff1d 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2013. All Rights Reserved. +%% Copyright Ericsson AB 1999-2015. 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. @@ -117,7 +117,7 @@ copy_anno(Kdst, Ksrc) -> fcount=0, %Fun counter ds=cerl_sets:new() :: cerl_sets:set(), %Defined variables funs=[], %Fun functions - free=[], %Free variables + free=#{}, %Free variables ws=[] :: [warning()], %Warnings. guard_refc=0}). %> 0 means in guard @@ -143,8 +143,10 @@ attributes([]) -> []. include_attribute(type) -> false; include_attribute(spec) -> false; +include_attribute(callback) -> false; include_attribute(opaque) -> false; include_attribute(export_type) -> false; +include_attribute(record) -> false; include_attribute(_) -> true. function({#c_var{name={F,Arity}=FA},Body}, St0) -> @@ -1837,14 +1839,17 @@ handle_reuse_anno_1(V, _St) -> V. %% get_free(Name, Arity, State) -> [Free]. %% store_free(Name, Arity, [Free], State) -> State. -get_free(F, A, St) -> - case orddict:find({F,A}, St#kern.free) of - {ok,Val} -> Val; - error -> [] +get_free(F, A, #kern{free=FreeMap}) -> + Key = {F,A}, + case FreeMap of + #{Key:=Val} -> Val; + _ -> [] end. -store_free(F, A, Free, St) -> - St#kern{free=orddict:store({F,A}, Free, St#kern.free)}. +store_free(F, A, Free, #kern{free=FreeMap0}=St) -> + Key = {F,A}, + FreeMap = FreeMap0#{Key=>Free}, + St#kern{free=FreeMap}. break_rets({break,Rs}) -> Rs; break_rets(return) -> []. diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile index 6553d10077..c2d757da4d 100644 --- a/lib/compiler/test/Makefile +++ b/lib/compiler/test/Makefile @@ -11,6 +11,8 @@ MODULES= \ beam_validator_SUITE \ beam_disasm_SUITE \ beam_except_SUITE \ + beam_reorder_SUITE \ + beam_type_SUITE \ beam_utils_SUITE \ bs_bincomp_SUITE \ bs_bit_binaries_SUITE \ @@ -43,6 +45,8 @@ NO_OPT= \ andor \ apply \ beam_except \ + beam_reorder \ + beam_type \ beam_utils \ bs_construct \ bs_match \ @@ -105,7 +109,7 @@ RELSYSDIR = $(RELEASE_PATH)/compiler_test # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +clint +clint0 +ERL_COMPILE_FLAGS += +clint +clint0 EBIN = . diff --git a/lib/compiler/test/andor_SUITE.erl b/lib/compiler/test/andor_SUITE.erl index fae9597c8a..264dc38907 100644 --- a/lib/compiler/test/andor_SUITE.erl +++ b/lib/compiler/test/andor_SUITE.erl @@ -25,7 +25,7 @@ combined/1,in_case/1,before_and_inside_if/1, slow_compilation/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/compiler/test/apply_SUITE.erl b/lib/compiler/test/apply_SUITE.erl index 3425553fed..868bc674f9 100644 --- a/lib/compiler/test/apply_SUITE.erl +++ b/lib/compiler/test/apply_SUITE.erl @@ -24,7 +24,7 @@ -export([foo/0,bar/1,baz/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/compiler/test/beam_disasm_SUITE.erl b/lib/compiler/test/beam_disasm_SUITE.erl index 4dd92e7ed9..4268729e75 100644 --- a/lib/compiler/test/beam_disasm_SUITE.erl +++ b/lib/compiler/test/beam_disasm_SUITE.erl @@ -19,7 +19,7 @@ %% -module(beam_disasm_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). diff --git a/lib/compiler/test/beam_reorder_SUITE.erl b/lib/compiler/test/beam_reorder_SUITE.erl new file mode 100644 index 0000000000..4b2262f65b --- /dev/null +++ b/lib/compiler/test/beam_reorder_SUITE.erl @@ -0,0 +1,69 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2015. 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_reorder_SUITE). + +-export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1, + init_per_group/2,end_per_group/2, + alloc/1]). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + test_lib:recompile(?MODULE), + [{group,p}]. + +groups() -> + [{p,[parallel], + [alloc + ]}]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +-record(alloc, {version}). + +alloc(_Config) -> + {ok,42} = alloc_a(1, 2, #alloc{version=42}), + {a,b,c} = alloc_b(1, 2, #alloc{version={a,b,c}}), + ok. + +alloc_a(_U1, _U2, R) -> + V = R#alloc.version, + Res = id({ok,V}), + _ = id(0), + Res. + +alloc_b(_U1, _U2, R) -> + V = R#alloc.version, + Res = id(V), + _ = id(0), + Res. + +id(I) -> + I. diff --git a/lib/compiler/test/beam_type_SUITE.erl b/lib/compiler/test/beam_type_SUITE.erl new file mode 100644 index 0000000000..8d5c0190ed --- /dev/null +++ b/lib/compiler/test/beam_type_SUITE.erl @@ -0,0 +1,98 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2015. 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_type_SUITE). + +-export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1, + init_per_group/2,end_per_group/2, + integers/1,coverage/1,booleans/1]). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + test_lib:recompile(?MODULE), + [{group,p}]. + +groups() -> + [{p,[parallel], + [integers, + coverage, + booleans + ]}]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +integers(_Config) -> + a = do_integers_1(2#11000), + b = do_integers_1(2#11001), + + a = do_integers_2(<<0:1>>), + {'EXIT',{{case_clause,-1},_}} = (catch do_integers_2(<<1:1>>)), + + ok. + +do_integers_1(B0) -> + B = B0 band 1, + case B band 15 of + 0 -> a; + 1 -> b + end. + +do_integers_2(Bin) -> + <<B:1/signed>> = Bin, + case B of + 0 -> a; + 1 -> b + end. + +coverage(_Config) -> + {'EXIT',{badarith,_}} = (catch id(1) bsl 0.5), + {'EXIT',{badarith,_}} = (catch id(2.0) bsl 2), + {'EXIT',{badarith,_}} = (catch a + 0.5), + {'EXIT',{badarith,_}} = (catch 2.0 * b), + + {'EXIT',{badarith,_}} = (catch id(42.0) / (1 bsl 2000)), + + id(id(42) band 387439739874298734983787934283479243879), + id(-1 band id(13)), + + ok. + +booleans(_Config) -> + {'EXIT',{{case_clause,_},_}} = (catch do_booleans(42)), + ok. + +do_booleans(B) -> + case is_integer(B) of + yes -> yes; + no -> no + end. + +id(I) -> + I. diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl index 69391b15eb..cb217e4655 100644 --- a/lib/compiler/test/beam_validator_SUITE.erl +++ b/lib/compiler/test/beam_validator_SUITE.erl @@ -34,7 +34,7 @@ undef_label/1,illegal_instruction/1,failing_gc_guard_bif/1, map_field_lists/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> Dog = test_server:timetrap(?t:minutes(10)), @@ -107,13 +107,13 @@ xrange(Config) when is_list(Config) -> {{bif,'+',{f,0},[{x,-1},{x,1}],{x,0}},4, {uninitialized_reg,{x,-1}}}}, {{t,sum_2,2}, - {{bif,'+',{f,0},[{x,0},{x,1024}],{x,0}},4, - {uninitialized_reg,{x,1024}}}}, + {{bif,'+',{f,0},[{x,0},{x,1023}],{x,0}},4, + {uninitialized_reg,{x,1023}}}}, {{t,sum_3,2}, {{bif,'+',{f,0},[{x,0},{x,1}],{x,-1}},4, {invalid_store,{x,-1},number}}}, {{t,sum_4,2}, - {{bif,'+',{f,0},[{x,0},{x,1}],{x,1024}},4,limit}}] = Errors, + {{bif,'+',{f,0},[{x,0},{x,1}],{x,1023}},4,limit}}] = Errors, ok. yrange(Config) when is_list(Config) -> diff --git a/lib/compiler/test/beam_validator_SUITE_data/xrange.S b/lib/compiler/test/beam_validator_SUITE_data/xrange.S index c6f20288f7..a76408dde3 100644 --- a/lib/compiler/test/beam_validator_SUITE_data/xrange.S +++ b/lib/compiler/test/beam_validator_SUITE_data/xrange.S @@ -20,7 +20,7 @@ {label,3}. {func_info,{atom,t},{atom,sum_2},2}. {label,4}. - {bif,'+',{f,0},[{x,0},{x,1024}],{x,0}}. + {bif,'+',{f,0},[{x,0},{x,1023}],{x,0}}. {'%live',1}. return. @@ -38,7 +38,7 @@ {label,7}. {func_info,{atom,t},{atom,sum_4},2}. {label,8}. - {bif,'+',{f,0},[{x,0},{x,1}],{x,1024}}. + {bif,'+',{f,0},[{x,0},{x,1}],{x,1023}}. {'%live',1}. return. diff --git a/lib/compiler/test/bs_bincomp_SUITE.erl b/lib/compiler/test/bs_bincomp_SUITE.erl index 1bf4e9d4a7..d9865c3746 100644 --- a/lib/compiler/test/bs_bincomp_SUITE.erl +++ b/lib/compiler/test/bs_bincomp_SUITE.erl @@ -28,7 +28,7 @@ extended_bit_aligned/1,mixed/1,filters/1,trim_coverage/1, nomatch/1,sizes/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/compiler/test/bs_bit_binaries_SUITE.erl b/lib/compiler/test/bs_bit_binaries_SUITE.erl index afee52c9b9..5bda20e6d6 100644 --- a/lib/compiler/test/bs_bit_binaries_SUITE.erl +++ b/lib/compiler/test/bs_bit_binaries_SUITE.erl @@ -29,7 +29,7 @@ big_binary_to_and_from_list/1,send_and_receive/1, send_and_receive_alot/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/compiler/test/bs_construct_SUITE.erl b/lib/compiler/test/bs_construct_SUITE.erl index 87cfaaf73c..caf204032c 100644 --- a/lib/compiler/test/bs_construct_SUITE.erl +++ b/lib/compiler/test/bs_construct_SUITE.erl @@ -31,7 +31,7 @@ nasty_literals/1,coerce_to_float/1,side_effect/1, opt/1,otp_7556/1,float_arith/1,otp_8054/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index b4601b0798..99539f3779 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -36,11 +36,12 @@ match_string/1,zero_width/1,bad_size/1,haystack/1, cover_beam_bool/1,matched_out_size/1,follow_fail_branch/1, no_partition/1,calling_a_binary/1,binary_in_map/1, - match_string_opt/1,map_and_binary/1]). + match_string_opt/1,select_on_integer/1, + map_and_binary/1,unsafe_branch_caching/1]). -export([coverage_id/1,coverage_external_ignore/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -62,7 +63,8 @@ groups() -> otp_7498,match_string,zero_width,bad_size,haystack, cover_beam_bool,matched_out_size,follow_fail_branch, no_partition,calling_a_binary,binary_in_map, - match_string_opt,map_and_binary]}]. + match_string_opt,select_on_integer, + map_and_binary,unsafe_branch_caching]}]. init_per_suite(Config) -> @@ -116,9 +118,16 @@ fun_shadow_4(L) -> int_float(Config) when is_list(Config) -> %% OTP-5323 - ?line <<103133.0:64/float>> = <<103133:64/float>>, - ?line <<103133:64/float>> = <<103133:64/float>>, - ok. + <<103133.0:64/float>> = <<103133:64/float>>, + <<103133:64/float>> = <<103133:64/float>>, + + %% Coverage of error cases in sys_pre_expand:coerce_to_float/2. + case id(default) of + <<(1 bsl 1024):64/float>> -> + ?t:fail(); + default -> + ok + end. %% Stolen from erl_eval_SUITE and modified. %% OTP-5269. Bugs in the bit syntax. @@ -1225,6 +1234,21 @@ match_string_opt(Config) when is_list(Config) -> do_match_string_opt({<<1>>,{v,V}}=T) -> {x,V,T}. +select_on_integer(Config) when is_list(Config) -> + 42 = do_select_on_integer(<<42>>), + <<"abc">> = do_select_on_integer(<<128,"abc">>), + + {'EXIT',_} = (catch do_select_on_integer(<<0:1>>)), + {'EXIT',_} = (catch do_select_on_integer(<<1:1>>)), + {'EXIT',_} = (catch do_select_on_integer(<<0:1,0:15>>)), + ok. + +%% The ASN.1 compiler frequently generates code like this. +do_select_on_integer(<<0:1,I:7>>) -> + I; +do_select_on_integer(<<1:1,_:7,Bin/binary>>) -> + Bin. + %% If 'bin_opt_info' was given the warning would lack filename %% and line number. @@ -1243,6 +1267,32 @@ do_map_and_binary(#{time := _} = T) -> do_map_and_binary(#{hour := Hour, min := Min} = T) -> {Hour, Min, T}. +%% Unsafe caching of branch outcomes in beam_bsm would cause the +%% delayed creation of sub-binaries optimization to be applied even +%% when it was unsafe. + +unsafe_branch_caching(_Config) -> + <<>> = do_unsafe_branch_caching(<<42,1>>), + <<>> = do_unsafe_branch_caching(<<42,2>>), + <<>> = do_unsafe_branch_caching(<<42,3>>), + <<17,18>> = do_unsafe_branch_caching(<<42,3,17,18>>), + <<>> = do_unsafe_branch_caching(<<1,3,42,2>>), + + ok. + +do_unsafe_branch_caching(<<Code/integer, Bin/binary>>) -> + <<C1/integer, B1/binary>> = Bin, + case C1 of + X when X =:= 1 orelse X =:= 2 -> + Bin2 = <<>>; + _ -> + Bin2 = B1 + end, + case Code of + 1 -> do_unsafe_branch_caching(Bin2); + _ -> Bin2 + end. + check(F, R) -> R = F(). diff --git a/lib/compiler/test/bs_utf_SUITE.erl b/lib/compiler/test/bs_utf_SUITE.erl index e6d292d9e6..ffe8de00d4 100644 --- a/lib/compiler/test/bs_utf_SUITE.erl +++ b/lib/compiler/test/bs_utf_SUITE.erl @@ -26,7 +26,7 @@ utf32_roundtrip/1,guard/1,extreme_tripping/1, literals/1,coverage/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/compiler/test/compilation_SUITE.erl b/lib/compiler/test/compilation_SUITE.erl index 2715a3aec5..6bff5e55f2 100644 --- a/lib/compiler/test/compilation_SUITE.erl +++ b/lib/compiler/test/compilation_SUITE.erl @@ -20,7 +20,7 @@ -module(compilation_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -compile(export_all). diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index cbdd9ce8cd..c69e0ac408 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -21,7 +21,7 @@ %% Tests compile:file/1 and compile:file/2 with various options. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, @@ -29,7 +29,7 @@ file_1/1, forms_2/1, module_mismatch/1, big_file/1, outdir/1, binary/1, makedep/1, cond_and_ifdef/1, listings/1, listings_big/1, other_output/1, encrypted_abstr/1, - bad_record_use1/1, bad_record_use2/1, strict_record/1, + strict_record/1, missing_testheap/1, cover/1, env/1, core/1, asm/1, sys_pre_attributes/1, dialyzer/1, warnings/1 @@ -48,13 +48,12 @@ all() -> [app_test, appup_test, file_1, forms_2, module_mismatch, big_file, outdir, binary, makedep, cond_and_ifdef, listings, listings_big, other_output, encrypted_abstr, - {group, bad_record_use}, strict_record, + strict_record, missing_testheap, cover, env, core, asm, sys_pre_attributes, dialyzer, warnings]. groups() -> - [{bad_record_use, [], - [bad_record_use1, bad_record_use2]}]. + []. init_per_suite(Config) -> Config. @@ -86,7 +85,7 @@ file_1(Config) when is_list(Config) -> process_flag(trap_exit, true), - ?line {Simple, Target} = files(Config, "file_1"), + {Simple, Target} = get_files(Config, simple, "file_1"), ?line {ok, Cwd} = file:get_cwd(), ?line ok = file:set_cwd(filename:dirname(Target)), @@ -161,11 +160,8 @@ module_mismatch(Config) when is_list(Config) -> big_file(Config) when is_list(Config) -> ?line Dog = test_server:timetrap(test_server:minutes(5)), - ?line DataDir = ?config(data_dir, Config), - ?line PrivDir = ?config(priv_dir, Config), - ?line Big = filename:join(DataDir, "big.erl"), - ?line Target = filename:join(PrivDir, "big.beam"), - ?line ok = file:set_cwd(PrivDir), + {Big,Target} = get_files(Config, big, "big_file"), + ok = file:set_cwd(filename:dirname(Target)), ?line compile_and_verify(Big, Target, []), ?line compile_and_verify(Big, Target, [debug_info]), ?line compile_and_verify(Big, Target, [no_postopt]), @@ -179,7 +175,7 @@ big_file(Config) when is_list(Config) -> outdir(Config) when is_list(Config) -> ?line Dog = test_server:timetrap(test_server:seconds(60)), - ?line {Simple, Target} = files(Config, "outdir"), + {Simple, Target} = get_files(Config, simple, "outdir"), ?line {ok, simple} = compile:file(Simple, [{outdir, filename:dirname(Target)}]), ?line true = exists(Target), ?line passed = run(Target, test, []), @@ -192,7 +188,7 @@ outdir(Config) when is_list(Config) -> binary(Config) when is_list(Config) -> ?line Dog = test_server:timetrap(test_server:seconds(60)), - ?line {Simple, Target} = files(Config, "binary"), + {Simple, Target} = get_files(Config, simple, "binary"), ?line {ok, simple, Binary} = compile:file(Simple, [binary]), ?line code:load_binary(simple, Target, Binary), ?line passed = simple:test(), @@ -206,7 +202,7 @@ binary(Config) when is_list(Config) -> makedep(Config) when is_list(Config) -> ?line Dog = test_server:timetrap(test_server:seconds(60)), - ?line {Simple,Target} = files(Config, "makedep"), + {Simple,Target} = get_files(Config, simple, "makedep"), ?line DataDir = ?config(data_dir, Config), ?line SimpleRootname = filename:rootname(Simple), ?line IncludeDir = filename:join(filename:dirname(Simple), "include"), @@ -282,7 +278,7 @@ makedep_modify_target(Mf, Target) -> cond_and_ifdef(Config) when is_list(Config) -> ?line Dog = test_server:timetrap(test_server:seconds(60)), - ?line {Simple, Target} = files(Config, "cond_and_ifdef"), + {Simple, Target} = get_files(Config, simple, "cond_and_ifdef"), ?line IncludeDir = filename:join(filename:dirname(Simple), "include"), ?line Options = [{outdir, filename:dirname(Target)}, {d, need_foo}, {d, foo_value, 42}, @@ -330,6 +326,8 @@ do_file_listings(DataDir, PrivDir, [File|Files]) -> do_listing(Simple, TargetDir, dlife, ".life"), do_listing(Simple, TargetDir, dcg, ".codegen"), do_listing(Simple, TargetDir, dblk, ".block"), + do_listing(Simple, TargetDir, dexcept, ".except"), + do_listing(Simple, TargetDir, dbs, ".bs"), do_listing(Simple, TargetDir, dbool, ".bool"), do_listing(Simple, TargetDir, dtype, ".type"), do_listing(Simple, TargetDir, ddead, ".dead"), @@ -360,21 +358,18 @@ do_file_listings(DataDir, PrivDir, [File|Files]) -> listings_big(Config) when is_list(Config) -> ?line Dog = test_server:timetrap(test_server:minutes(10)), - ?line DataDir = ?config(data_dir, Config), - ?line PrivDir = ?config(priv_dir, Config), - ?line Big = filename:join(DataDir, big), - ?line TargetDir = filename:join(PrivDir, listings_big), - ?line ok = file:make_dir(TargetDir), + {Big,Target} = get_files(Config, big, listings_big), + TargetDir = filename:dirname(Target), ?line do_listing(Big, TargetDir, 'S'), ?line do_listing(Big, TargetDir, 'E'), ?line do_listing(Big, TargetDir, 'P'), ?line do_listing(Big, TargetDir, dkern, ".kernel"), - ?line Target = filename:join(TargetDir, big), - {ok,big} = compile:file(Target, [from_asm,{outdir,TargetDir}]), + TargetNoext = filename:rootname(Target, code:objfile_extension()), + {ok,big} = compile:file(TargetNoext, [from_asm,{outdir,TargetDir}]), %% Cleanup. - ?line ok = file:delete(Target ++ ".beam"), + ok = file:delete(Target), ?line lists:foreach(fun(F) -> ok = file:delete(F) end, filelib:wildcard(filename:join(TargetDir, "*"))), ?line ok = file:del_dir(TargetDir), @@ -383,11 +378,7 @@ listings_big(Config) when is_list(Config) -> other_output(Config) when is_list(Config) -> ?line Dog = test_server:timetrap(test_server:minutes(8)), - ?line DataDir = ?config(data_dir, Config), - ?line PrivDir = ?config(priv_dir, Config), - ?line Simple = filename:join(DataDir, simple), - ?line TargetDir = filename:join(PrivDir, other_output), - ?line ok = file:make_dir(TargetDir), + {Simple,_Target} = get_files(Config, simple, "other_output"), io:put_chars("to_pp"), ?line {ok,[],PP} = compile:file(Simple, [to_pp,binary,time]), @@ -432,7 +423,7 @@ other_output(Config) when is_list(Config) -> encrypted_abstr(Config) when is_list(Config) -> ?line Dog = test_server:timetrap(test_server:minutes(10)), - ?line {Simple,Target} = files(Config, "encrypted_abstr"), + {Simple,Target} = get_files(Config, simple, "encrypted_abstr"), Res = case has_crypto() of false -> @@ -580,17 +571,17 @@ do_listing(Source, TargetDir, Type, Ext) -> Target = filename:join(TargetDir, SourceBase ++ Ext), true = exists(Target). -files(Config, Name) -> - ?line code:delete(simple), - ?line code:purge(simple), - ?line DataDir = ?config(data_dir, Config), - ?line PrivDir = ?config(priv_dir, Config), - ?line Simple = filename:join(DataDir, "simple"), - ?line TargetDir = filename:join(PrivDir, Name), - ?line ok = file:make_dir(TargetDir), - ?line Target = filename:join(TargetDir, "simple"++code:objfile_extension()), - {Simple, Target}. - +get_files(Config, Module, OutputName) -> + code:delete(Module), + code:purge(Module), + DataDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), + Src = filename:join(DataDir, atom_to_list(Module)), + TargetDir = filename:join(PrivDir, OutputName), + ok = file:make_dir(TargetDir), + File = atom_to_list(Module) ++ code:objfile_extension(), + Target = filename:join(TargetDir, File), + {Src, Target}. run(Target, Func, Args) -> ?line Module = list_to_atom(filename:rootname(filename:basename(Target))), @@ -607,28 +598,6 @@ exists(Name) -> end. -%% Tests that the compiler does not accept -%% bad use of records. -bad_record_use1(Config) when is_list(Config) -> - ?line {ok, Cwd} = file:get_cwd(), - ?line file:set_cwd(?config(data_dir, Config)), - ?line true=exists("bad_record_use.erl"), - ?line Ret=c:c(bad_record_use), - ?line file:set_cwd(Cwd), - ?line error=Ret, - ok. - -%% Tests that the compiler does not accept -%% bad use of records. -bad_record_use2(Config) when is_list(Config) -> - ?line {ok, Cwd} = file:get_cwd(), - ?line file:set_cwd(?config(data_dir, Config)), - ?line true=exists("bad_record_use2.erl"), - ?line Ret=c:c(bad_record_use), - ?line file:set_cwd(Cwd), - ?line error=Ret, - ok. - strict_record(Config) when is_list(Config) -> ?line Priv = ?config(priv_dir, Config), ?line file:set_cwd(?config(data_dir, Config)), @@ -713,7 +682,7 @@ init(ReplyTo, Fun, _Filler) -> ReplyTo ! {result, Fun()}. env(Config) when is_list(Config) -> - ?line {Simple,Target} = files(Config, "file_1"), + {Simple,Target} = get_files(Config, simple, env), ?line {ok,Cwd} = file:get_cwd(), ?line ok = file:set_cwd(filename:dirname(Target)), @@ -722,9 +691,9 @@ env(Config) when is_list(Config) -> env_1(Simple, Target) after true = os:putenv("ERL_COMPILER_OPTIONS", "ignore_me"), - file:set_cwd(Cwd), - file:delete(Target), - file:del_dir(filename:dirname(Target)) + file:set_cwd(Cwd), + file:delete(Target), + file:del_dir(filename:dirname(Target)) end, ok. diff --git a/lib/compiler/test/compile_SUITE_data/bad_record_use.erl b/lib/compiler/test/compile_SUITE_data/bad_record_use.erl deleted file mode 100644 index 0fb6fc3045..0000000000 --- a/lib/compiler/test/compile_SUITE_data/bad_record_use.erl +++ /dev/null @@ -1,29 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2009. 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(bad_record_use). --export([test/0]). - --record(bad_use, {a=undefined, - b=undefined, - c=undefined}). - -test() -> - NewRecord=#bad_use{a=1, b=2, a=2}. - diff --git a/lib/compiler/test/compile_SUITE_data/bad_record_use2.erl b/lib/compiler/test/compile_SUITE_data/bad_record_use2.erl deleted file mode 100644 index 7c898af00f..0000000000 --- a/lib/compiler/test/compile_SUITE_data/bad_record_use2.erl +++ /dev/null @@ -1,30 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2009. 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(bad_record_use2). --export([test/0]). - --record(bad_use, {a=undefined, - b=undefined, - c=undefined}). - -test() -> - R=#bad_use{a=1, b=2}, - R2=R#bad_use{a=1, b=2, a=2}, - ok. diff --git a/lib/compiler/test/core_SUITE.erl b/lib/compiler/test/core_SUITE.erl index 25f8564ce4..ddc4c7af5e 100644 --- a/lib/compiler/test/core_SUITE.erl +++ b/lib/compiler/test/core_SUITE.erl @@ -29,7 +29,7 @@ bs_shadowed_size_var/1 ]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(comp(N), N(Config) when is_list(Config) -> try_it(N, Config)). diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl index 016ea9d0d9..36faea1363 100644 --- a/lib/compiler/test/core_fold_SUITE.erl +++ b/lib/compiler/test/core_fold_SUITE.erl @@ -29,7 +29,7 @@ -export([foo/0,foo/1,foo/2,foo/3]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/compiler/test/error_SUITE.erl b/lib/compiler/test/error_SUITE.erl index 2962e3ff77..f4662ec7b2 100644 --- a/lib/compiler/test/error_SUITE.erl +++ b/lib/compiler/test/error_SUITE.erl @@ -18,7 +18,7 @@ %% %CopyrightEnd% -module(error_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, diff --git a/lib/compiler/test/float_SUITE.erl b/lib/compiler/test/float_SUITE.erl index 1b313ad021..60efe4f228 100644 --- a/lib/compiler/test/float_SUITE.erl +++ b/lib/compiler/test/float_SUITE.erl @@ -22,7 +22,7 @@ init_per_group/2,end_per_group/2, pending/1,bif_calls/1,math_functions/1,mixed_float_and_int/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/compiler/test/fun_SUITE.erl b/lib/compiler/test/fun_SUITE.erl index 36a4d6fce2..c6cc5b17b3 100644 --- a/lib/compiler/test/fun_SUITE.erl +++ b/lib/compiler/test/fun_SUITE.erl @@ -27,7 +27,7 @@ %% Internal exports. -export([call_me/1,dup1/0,dup2/0]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl index b3b67155b3..5391771dad 100644 --- a/lib/compiler/test/guard_SUITE.erl +++ b/lib/compiler/test/guard_SUITE.erl @@ -19,7 +19,7 @@ %% -module(guard_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, @@ -34,7 +34,8 @@ tricky/1,rel_ops/1,rel_op_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]). + bad_constants/1,bad_guards/1,scotland/1, + guard_in_catch/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -52,7 +53,7 @@ groups() -> rel_ops,rel_op_combinations, literal_type_tests,basic_andalso_orelse,traverse_dcd, check_qlc_hrl,andalso_semi,t_tuple_size,binary_part, - bad_constants,bad_guards]}]. + bad_constants,bad_guards,scotland,guard_in_catch]}]. init_per_suite(Config) -> Config. @@ -1831,6 +1832,80 @@ bad_guards_2(M, [_]) when M#{a := 0, b => 0}, map_size(M) -> bad_guards_3(M, [_]) when is_map(M) andalso M#{a := 0, b => 0}, length(M) -> ok. +%% beam_bool would remove the initialization of {y,0}. +%% (Thanks to Thomas Arts and QuickCheck.) + +scotland(_Config) -> + million = do_scotland(placed), + {'EXIT',{{badmatch,placed},_}} = (catch do_scotland(false)), + {'EXIT',{{badmatch,placed},_}} = (catch do_scotland(true)), + {'EXIT',{{badmatch,placed},_}} = (catch do_scotland(echo)), + ok. + +do_scotland(Echo) -> + found(case Echo of + Echo when true; Echo, Echo, Echo -> + Echo; + echo -> + [] + end, + Echo = placed). + +found(_, _) -> million. + +%% Building maps in a guard in a 'catch' would crash v3_codegen. + +guard_in_catch(_Config) -> + {'EXIT',{if_clause,_}} = do_guard_in_catch_map_1(#{}), + {'EXIT',{if_clause,_}} = do_guard_in_catch_map_1(#{a=>b}), + {'EXIT',{if_clause,_}} = do_guard_in_catch_map_1(atom), + + {'EXIT',{if_clause,_}} = do_guard_in_catch_map_2(#{}), + {'EXIT',{if_clause,_}} = do_guard_in_catch_map_2(#{a=>b}), + {'EXIT',{if_clause,_}} = do_guard_in_catch_map_2(atom), + + {'EXIT',{if_clause,_}} = (catch do_guard_in_catch_map_3()), + + {'EXIT',{if_clause,_}} = do_guard_in_catch_bin(42), + {'EXIT',{if_clause,_}} = do_guard_in_catch_bin(<<1,2,3>>), + {'EXIT',{if_clause,_}} = do_guard_in_catch_bin(atom), + {'EXIT',{if_clause,_}} = do_guard_in_catch_bin(#{}), + + ok. + +do_guard_in_catch_map_1(From) -> + catch + if + From#{[] => sufficient} -> + saint + end. + +do_guard_in_catch_map_2(From) -> + catch + if + From#{From => sufficient} -> + saint + end. + +do_guard_in_catch_map_3() -> + try + if [] -> solo end + catch + Friendly when Friendly#{0 => []} -> minutes + after + membership + end. + +do_guard_in_catch_bin(From) -> + %% Would not crash v3_codegen, but there would be an unnecessary + %% 'move' to a Y register. + catch + if + <<From:32>> -> + saint + end. + + %% Call this function to turn off constant propagation. id(I) -> I. diff --git a/lib/compiler/test/inline_SUITE.erl b/lib/compiler/test/inline_SUITE.erl index 0b92a784de..f28e1e5a25 100644 --- a/lib/compiler/test/inline_SUITE.erl +++ b/lib/compiler/test/inline_SUITE.erl @@ -21,7 +21,7 @@ -module(inline_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -compile(export_all). -compile({inline,[badarg/2]}). diff --git a/lib/compiler/test/lc_SUITE.erl b/lib/compiler/test/lc_SUITE.erl index d10839ccf2..43e23f3b46 100644 --- a/lib/compiler/test/lc_SUITE.erl +++ b/lib/compiler/test/lc_SUITE.erl @@ -26,7 +26,7 @@ empty_generator/1,no_export/1,shadow/1, effect/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/compiler/test/map_SUITE.erl b/lib/compiler/test/map_SUITE.erl index 411b15eebe..af98584e00 100644 --- a/lib/compiler/test/map_SUITE.erl +++ b/lib/compiler/test/map_SUITE.erl @@ -883,6 +883,9 @@ t_update_map_expressions(Config) when is_list(Config) -> %% Error cases. {'EXIT',{{badmap,<<>>},_}} = (catch (id(<<>>))#{ a := 42, b => 2 }), {'EXIT',{{badmap,[]},_}} = (catch (id([]))#{ a := 42, b => 2 }), + {'EXIT',{{badmap,_},_}} = + (catch (fun t_update_map_expressions/1)#{u => 42}), + ok. @@ -1882,7 +1885,7 @@ register_corruption_dummy_call(A,B,C) -> {A,B,C}. t_frequency_table(Config) when is_list(Config) -> - random:seed({13,1337,54}), % pseudo random + rand:seed(exsplus, {13,1337,54}), % pseudo random N = 100000, Ts = rand_terms(N), #{ n:=N, tf := Tf } = frequency_table(Ts,#{ n=>0, tf => #{}}), @@ -1925,7 +1928,7 @@ rand_terms(0) -> []; rand_terms(N) -> [rand_term()|rand_terms(N-1)]. rand_term() -> - case random:uniform(6) of + case rand:uniform(6) of 1 -> rand_binary(); 2 -> rand_number(); 3 -> rand_atom(); @@ -1935,21 +1938,21 @@ rand_term() -> end. rand_binary() -> - case random:uniform(3) of + case rand:uniform(3) of 1 -> <<>>; 2 -> <<"hi">>; 3 -> <<"message text larger than 64 bytes. yep, message text larger than 64 bytes.">> end. rand_number() -> - case random:uniform(3) of - 1 -> random:uniform(5); - 2 -> float(random:uniform(5)); - 3 -> 1 bsl (63 + random:uniform(3)) + case rand:uniform(3) of + 1 -> rand:uniform(5); + 2 -> float(rand:uniform(5)); + 3 -> 1 bsl (63 + rand:uniform(3)) end. rand_atom() -> - case random:uniform(3) of + case rand:uniform(3) of 1 -> hi; 2 -> some_atom; 3 -> some_other_atom @@ -1957,21 +1960,21 @@ rand_atom() -> rand_tuple() -> - case random:uniform(3) of + case rand:uniform(3) of 1 -> {ok, rand_term()}; % careful 2 -> {1, 2, 3}; 3 -> {<<"yep">>, 1337} end. rand_list() -> - case random:uniform(3) of + case rand:uniform(3) of 1 -> "hi"; 2 -> [1,rand_term()]; % careful 3 -> [improper|list] end. rand_map() -> - case random:uniform(3) of + case rand:uniform(3) of 1 -> #{ hi => 3 }; 2 -> #{ wat => rand_term(), other => 3 }; % careful 3 -> #{ hi => 42, other => 42, yet_anoter => 1337 } diff --git a/lib/compiler/test/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl index 67d668f650..8e88d26b62 100644 --- a/lib/compiler/test/match_SUITE.erl +++ b/lib/compiler/test/match_SUITE.erl @@ -26,7 +26,7 @@ selectify/1,underscore/1,match_map/1,map_vars_used/1, coverage/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -449,7 +449,10 @@ do_map_vars_used(X, Y, Map) -> coverage(Config) when is_list(Config) -> %% Cover beam_dead. ok = coverage_1(x, a), - ok = coverage_1(x, b). + ok = coverage_1(x, b), + + %% Cover sys_pre_expand. + ok = coverage_3("abc"). coverage_1(B, Tag) -> case Tag of @@ -460,4 +463,6 @@ coverage_1(B, Tag) -> coverage_2(1, a, x) -> ok; coverage_2(2, b, x) -> ok. +coverage_3([$a]++[]++"bc") -> ok. + id(I) -> I. diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl index 8606935504..9c65151685 100644 --- a/lib/compiler/test/misc_SUITE.erl +++ b/lib/compiler/test/misc_SUITE.erl @@ -25,7 +25,7 @@ tobias/1,empty_string/1,md5/1,silly_coverage/1, confused_literals/1,integer_encoding/1,override_bif/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% For the override_bif testcase. %% NB, no other testcases in this testsuite can use these without erlang:prefix! @@ -38,7 +38,11 @@ -compile({no_auto_import,[byte_size/1]}). -import(erlang,[byte_size/1]). - +%% Cover the code for callback handling. +-callback must_define_this_one() -> 'ok'. +-callback do_something_strange(atom()) -> 'ok'. +-optional_callbacks([do_something_strange/1]). +-optional_callbacks([ignore_me]). %Invalid; ignored. %% Include an opaque declaration to cover the stripping of %% opaque types from attributes in v3_kernel. @@ -192,6 +196,14 @@ silly_coverage(Config) when is_list(Config) -> {label,2}|non_proper_list]}],99}, expect_error(fun() -> beam_a:module(BeamAInput, []) end), + %% beam_reorder + BlockInput = {?MODULE,[{foo,0}],[], + [{function,foo,0,2, + [{label,1}, + {func_info,{atom,?MODULE},{atom,foo},0}, + {label,2}|non_proper_list]}],99}, + expect_error(fun() -> beam_reorder:module(BlockInput, []) end), + %% beam_block BlockInput = {?MODULE,[{foo,0}],[], [{function,foo,0,2, @@ -200,6 +212,10 @@ silly_coverage(Config) when is_list(Config) -> {label,2}|non_proper_list]}],99}, ?line expect_error(fun() -> beam_block:module(BlockInput, []) end), + %% beam_bs + BsInput = BlockInput, + expect_error(fun() -> beam_bs:module(BsInput, []) end), + %% beam_type TypeInput = {?MODULE,[{foo,0}],[], [{function,foo,0,2, @@ -373,9 +389,9 @@ integer_encoding_1(Config) -> do_integer_encoding(0, _, _, _) -> ok; do_integer_encoding(N, I0, Src, Data) -> - I1 = (I0 bsl 5) bor (random:uniform(32) - 1), + I1 = (I0 bsl 5) bor (rand:uniform(32) - 1), do_integer_encoding(I1, Src, Data), - I2 = -(I1 bxor (random:uniform(32) - 1)), + I2 = -(I1 bxor (rand:uniform(32) - 1)), do_integer_encoding(I2, Src, Data), do_integer_encoding(N-1, I1, Src, Data). diff --git a/lib/compiler/test/num_bif_SUITE.erl b/lib/compiler/test/num_bif_SUITE.erl index d54fa203f0..a94ca40b38 100644 --- a/lib/compiler/test/num_bif_SUITE.erl +++ b/lib/compiler/test/num_bif_SUITE.erl @@ -19,7 +19,7 @@ %% -module(num_bif_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Tests optimization of the BIFs: %% abs/1 diff --git a/lib/compiler/test/receive_SUITE.erl b/lib/compiler/test/receive_SUITE.erl index 4016fac0b5..fef29ab06d 100644 --- a/lib/compiler/test/receive_SUITE.erl +++ b/lib/compiler/test/receive_SUITE.erl @@ -27,7 +27,7 @@ export/1,recv/1,coverage/1,otp_7980/1,ref_opt/1, wait/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). init_per_testcase(_Case, Config) -> ?line Dog = test_server:timetrap(test_server:minutes(2)), diff --git a/lib/compiler/test/record_SUITE.erl b/lib/compiler/test/record_SUITE.erl index 2ef379e43f..48a2a9f5df 100644 --- a/lib/compiler/test/record_SUITE.erl +++ b/lib/compiler/test/record_SUITE.erl @@ -21,7 +21,7 @@ -module(record_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, diff --git a/lib/compiler/test/regressions_SUITE.erl b/lib/compiler/test/regressions_SUITE.erl index 716a9693ed..a8caa34c60 100644 --- a/lib/compiler/test/regressions_SUITE.erl +++ b/lib/compiler/test/regressions_SUITE.erl @@ -19,7 +19,7 @@ %% Test specific code snippets that has crashed the compiler in the past. -module(regressions_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, groups/0, init_per_testcase/2,end_per_testcase/2]). diff --git a/lib/compiler/test/test_lib.erl b/lib/compiler/test/test_lib.erl index 09ec8f3c81..e4b6a2fa9c 100644 --- a/lib/compiler/test/test_lib.erl +++ b/lib/compiler/test/test_lib.erl @@ -19,7 +19,7 @@ %% -module(test_lib). --include_lib("test_server/include/test_server.hrl"). +-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, smoke_disasm/1,p_run/2,binary_part/2]). diff --git a/lib/compiler/test/trycatch_SUITE.erl b/lib/compiler/test/trycatch_SUITE.erl index adcab8ef67..b316776f50 100644 --- a/lib/compiler/test/trycatch_SUITE.erl +++ b/lib/compiler/test/trycatch_SUITE.erl @@ -28,7 +28,7 @@ plain_catch_coverage/1,andalso_orelse/1,get_in_try/1, hockey/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/compiler/test/warnings_SUITE.erl b/lib/compiler/test/warnings_SUITE.erl index a964afe5a1..2a425c2ae5 100644 --- a/lib/compiler/test/warnings_SUITE.erl +++ b/lib/compiler/test/warnings_SUITE.erl @@ -27,7 +27,7 @@ -define(privdir, "warnings_SUITE_priv"). -define(t, test_server). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(datadir, ?config(data_dir, Conf)). -define(privdir, ?config(priv_dir, Conf)). -endif. diff --git a/lib/cosEvent/test/Makefile b/lib/cosEvent/test/Makefile index 2d29afd20d..028b0221b6 100644 --- a/lib/cosEvent/test/Makefile +++ b/lib/cosEvent/test/Makefile @@ -96,12 +96,10 @@ TARGET_FILES = \ ERL_IDL_FLAGS += -pa $(ERL_TOP)/lib/orber/ebin -pa $(ERL_TOP)/lib/ic/ebin ERL_COMPILE_FLAGS += $(ERL_IDL_FLAGS) \ - -pa $(ERL_TOP)/lib/test_server/ebin \ -pa $(ERL_TOP)/lib/cosEvent/ebin \ -pa $(ERL_TOP)/lib/cosEvent/test/idl_output \ -I$(ERL_TOP)/lib/cosEvent \ - -I$(ERL_TOP)/lib/cosEvent/test/$(IDLOUTDIR) \ - -I$(ERL_TOP)/lib/test_server/include + -I$(ERL_TOP)/lib/cosEvent/test/$(IDLOUTDIR) # ---------------------------------------------------- # Targets diff --git a/lib/cosEvent/test/event_channel_SUITE.erl b/lib/cosEvent/test/event_channel_SUITE.erl index 0d67a94520..3a01a0eab6 100644 --- a/lib/cosEvent/test/event_channel_SUITE.erl +++ b/lib/cosEvent/test/event_channel_SUITE.erl @@ -23,7 +23,7 @@ -module(event_channel_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -include_lib("orber/COSS/CosNaming/CosNaming.hrl"). -include_lib("orber/src/orber_iiop.hrl"). diff --git a/lib/cosEvent/test/generated_SUITE.erl b/lib/cosEvent/test/generated_SUITE.erl index 40fe94386a..1533c0be9c 100644 --- a/lib/cosEvent/test/generated_SUITE.erl +++ b/lib/cosEvent/test/generated_SUITE.erl @@ -26,7 +26,7 @@ -module(generated_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -define(default_timeout, ?t:minutes(3)). diff --git a/lib/cosEventDomain/test/Makefile b/lib/cosEventDomain/test/Makefile index 1bbd1f1693..d8f6a863d6 100644 --- a/lib/cosEventDomain/test/Makefile +++ b/lib/cosEventDomain/test/Makefile @@ -61,15 +61,13 @@ ERL_IDL_FLAGS += -pa $(ERL_TOP)/lib/orber/ebin -pa $(ERL_TOP)/lib/ic/ebin ERL_COMPILE_FLAGS += \ $(ERL_IDL_FLAGS) \ - -pa $(ERL_TOP)/lib/test_server/ebin \ -pa $(ERL_TOP)/lib/cosEventDomain/ebin \ -pa $(ERL_TOP)/lib/cosEventDomain/include \ -pa $(ERL_TOP)/lib/cosNotification/ebin \ -pa $(ERL_TOP)/lib/cosNotification/include \ -I$(ERL_TOP)/lib/cosEventDomain/include \ -I$(ERL_TOP)/lib/cosNotification/include \ - -I$(ERL_TOP)/lib/cosNotification/ebin \ - -I$(ERL_TOP)/lib/test_server/include + -I$(ERL_TOP)/lib/cosNotification/ebin # ---------------------------------------------------- # Targets diff --git a/lib/cosEventDomain/test/event_domain_SUITE.erl b/lib/cosEventDomain/test/event_domain_SUITE.erl index 75835b03a0..37a04a34aa 100644 --- a/lib/cosEventDomain/test/event_domain_SUITE.erl +++ b/lib/cosEventDomain/test/event_domain_SUITE.erl @@ -23,7 +23,7 @@ -module(event_domain_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -include_lib("cosNotification/include/CosNotifyChannelAdmin.hrl"). -include_lib("cosNotification/include/CosNotification.hrl"). diff --git a/lib/cosEventDomain/test/generated_SUITE.erl b/lib/cosEventDomain/test/generated_SUITE.erl index 553516bed1..afaa70db0a 100644 --- a/lib/cosEventDomain/test/generated_SUITE.erl +++ b/lib/cosEventDomain/test/generated_SUITE.erl @@ -26,7 +26,7 @@ -module(generated_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -define(default_timeout, ?t:minutes(3)). diff --git a/lib/cosFileTransfer/test/Makefile b/lib/cosFileTransfer/test/Makefile index 39512d83bd..332f90cb39 100644 --- a/lib/cosFileTransfer/test/Makefile +++ b/lib/cosFileTransfer/test/Makefile @@ -85,7 +85,6 @@ ERL_COMPILE_FLAGS += \ $(ERL_IDL_FLAGS) \ -pa $(ERL_TOP)/lib/orber/include \ -pa $(ERL_TOP)/lib/cosProperty/include \ - -pa $(ERL_TOP)/internal_tools/test_server/ebin \ -pa $(ERL_TOP)/lib/cosFileTransfer/ebin \ -pa $(ERL_TOP)/lib/cosFileTransfer/include \ -pa $(ERL_TOP)/lib/cosFileTransfer/test/idl_output \ @@ -94,8 +93,7 @@ ERL_COMPILE_FLAGS += \ -I$(ERL_TOP)/lib/cosFileTransfer/src \ -I$(ERL_TOP)/lib/cosFileTransfer/include \ -I$(ERL_TOP)/lib/cosFileTransfer \ - -I$(ERL_TOP)/lib/cosFileTransfer/test/$(IDLOUTDIR) \ - -I$(ERL_TOP)/lib/test_server/include + -I$(ERL_TOP)/lib/cosFileTransfer/test/$(IDLOUTDIR) # ---------------------------------------------------- # Targets diff --git a/lib/cosFileTransfer/test/fileTransfer_SUITE.erl b/lib/cosFileTransfer/test/fileTransfer_SUITE.erl index 3fb08dbcdd..173cf71e61 100644 --- a/lib/cosFileTransfer/test/fileTransfer_SUITE.erl +++ b/lib/cosFileTransfer/test/fileTransfer_SUITE.erl @@ -29,7 +29,7 @@ %%--------------- INCLUDES ----------------------------------- -include_lib("cosFileTransfer/src/cosFileTransferApp.hrl"). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %%--------------- DEFINES ------------------------------------ -define(default_timeout, ?t:minutes(20)). diff --git a/lib/cosNotification/src/CosNotifyFilter_Filter_impl.erl b/lib/cosNotification/src/CosNotifyFilter_Filter_impl.erl index 75510ebeca..0f997049e0 100644 --- a/lib/cosNotification/src/CosNotifyFilter_Filter_impl.erl +++ b/lib/cosNotification/src/CosNotifyFilter_Filter_impl.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. 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. @@ -336,6 +336,7 @@ match_structured(_,_,What) -> %% Returns : boolean() | %% {'EXCEPTION', CosNotifyFilter::UnsupportedFilterableData} %%----------------------------------------------------------- +-spec match_typed(_, _, _) -> no_return(). match_typed(_OE_THIS, _State, _Data) -> corba:raise(#'NO_IMPLEMENT'{completion_status=?COMPLETED_NO}). diff --git a/lib/cosNotification/src/CosNotifyFilter_MappingFilter_impl.erl b/lib/cosNotification/src/CosNotifyFilter_MappingFilter_impl.erl index 3718664674..03c0e03be6 100644 --- a/lib/cosNotification/src/CosNotifyFilter_MappingFilter_impl.erl +++ b/lib/cosNotification/src/CosNotifyFilter_MappingFilter_impl.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. 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. @@ -298,6 +298,7 @@ match_structured(_,_,_) -> %% Returns : boolean() , #any{} (out-type) | %% {'EXCEPTION', CosNotifyFilter::UnsupportedFilterableData} %%----------------------------------------------------------- +-spec match_typed(_, _, _) -> no_return(). match_typed(_OE_THIS, _State, _Data) -> corba:raise(#'NO_IMPLEMENT'{completion_status=?COMPLETED_NO}). diff --git a/lib/cosNotification/test/Makefile b/lib/cosNotification/test/Makefile index 1db6d2bc14..5a4c5e18aa 100644 --- a/lib/cosNotification/test/Makefile +++ b/lib/cosNotification/test/Makefile @@ -128,7 +128,6 @@ ERL_IDL_FLAGS += \ ERL_COMPILE_FLAGS += \ $(ERL_IDL_FLAGS) \ -pa $(ERL_TOP)/lib/orber/include \ - -pa $(ERL_TOP)/internal_tools/test_server/ebin \ -pa $(ERL_TOP)/lib/cosEvent/ebin \ -pa $(ERL_TOP)/lib/cosNotification/ebin \ -pa $(ERL_TOP)/lib/cosNotification/test/idl_output \ @@ -142,8 +141,7 @@ ERL_COMPILE_FLAGS += \ -I$(ERL_TOP)/lib/cosNotification/src \ -I$(ERL_TOP)/lib/cosNotification/include \ -I$(ERL_TOP)/lib/cosNotification \ - -I$(ERL_TOP)/lib/cosNotification/test/$(IDLOUTDIR) \ - -I$(ERL_TOP)/lib/test_server/include + -I$(ERL_TOP)/lib/cosNotification/test/$(IDLOUTDIR) # ---------------------------------------------------- # Targets diff --git a/lib/cosNotification/test/eventDB_SUITE.erl b/lib/cosNotification/test/eventDB_SUITE.erl index 0f0faed065..2d095adfae 100644 --- a/lib/cosNotification/test/eventDB_SUITE.erl +++ b/lib/cosNotification/test/eventDB_SUITE.erl @@ -42,7 +42,7 @@ -include("idl_output/notify_test.hrl"). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %%--------------- DEFINES ------------------------------------ -define(default_timeout, ?t:minutes(20)). diff --git a/lib/cosNotification/test/generated_SUITE.erl b/lib/cosNotification/test/generated_SUITE.erl index fe186f24e8..8e29989e30 100644 --- a/lib/cosNotification/test/generated_SUITE.erl +++ b/lib/cosNotification/test/generated_SUITE.erl @@ -26,7 +26,7 @@ -module(generated_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -define(default_timeout, ?t:minutes(3)). diff --git a/lib/cosNotification/test/grammar_SUITE.erl b/lib/cosNotification/test/grammar_SUITE.erl index eb0741ce04..b17ddba1c4 100644 --- a/lib/cosNotification/test/grammar_SUITE.erl +++ b/lib/cosNotification/test/grammar_SUITE.erl @@ -43,7 +43,7 @@ -include("idl_output/notify_test.hrl"). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %%--------------- DEFINES ------------------------------------ -define(default_timeout, ?t:minutes(20)). diff --git a/lib/cosNotification/test/notification_SUITE.erl b/lib/cosNotification/test/notification_SUITE.erl index b3884e7968..6824a2805f 100644 --- a/lib/cosNotification/test/notification_SUITE.erl +++ b/lib/cosNotification/test/notification_SUITE.erl @@ -41,7 +41,7 @@ -include("idl_output/notify_test.hrl"). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %%--------------- DEFINES ------------------------------------ -define(default_timeout, ?t:minutes(20)). diff --git a/lib/cosProperty/test/Makefile b/lib/cosProperty/test/Makefile index ec928a9789..b5e063129d 100644 --- a/lib/cosProperty/test/Makefile +++ b/lib/cosProperty/test/Makefile @@ -82,14 +82,12 @@ ERL_IDL_FLAGS += -pa $(ERL_TOP)/lib/cosProperty/ebin \ ERL_COMPILE_FLAGS += \ $(ERL_IDL_FLAGS) \ -pa $(ERL_TOP)/lib/orber/include \ - -pa $(ERL_TOP)/internal_tools/test_server/ebin \ -pa $(ERL_TOP)/lib/cosProperty/ebin \ -pa $(ERL_TOP)/lib/cosProperty/test/idl_output \ -I$(ERL_TOP)/lib/orber/include \ -I$(ERL_TOP)/lib/cosProperty/src \ -I$(ERL_TOP)/lib/cosProperty \ - -I$(ERL_TOP)/lib/cosProperty/test/$(IDLOUTDIR) \ - -I$(ERL_TOP)/lib/test_server/include + -I$(ERL_TOP)/lib/cosProperty/test/$(IDLOUTDIR) # ---------------------------------------------------- # Targets diff --git a/lib/cosProperty/test/generated_SUITE.erl b/lib/cosProperty/test/generated_SUITE.erl index 0422e0d018..1789650cbd 100644 --- a/lib/cosProperty/test/generated_SUITE.erl +++ b/lib/cosProperty/test/generated_SUITE.erl @@ -26,7 +26,7 @@ -module(generated_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -define(default_timeout, ?t:minutes(3)). diff --git a/lib/cosProperty/test/property_SUITE.erl b/lib/cosProperty/test/property_SUITE.erl index 94765e7479..ae508fa7b6 100644 --- a/lib/cosProperty/test/property_SUITE.erl +++ b/lib/cosProperty/test/property_SUITE.erl @@ -33,7 +33,7 @@ -include_lib("cosProperty/src/cosProperty.hrl"). -include_lib("cosProperty/include/CosPropertyService.hrl"). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %%--------------- DEFINES ------------------------------------ -define(default_timeout, ?t:minutes(20)). diff --git a/lib/cosTime/src/CosTime_TimeService_impl.erl b/lib/cosTime/src/CosTime_TimeService_impl.erl index f139998f42..72c65757ad 100644 --- a/lib/cosTime/src/CosTime_TimeService_impl.erl +++ b/lib/cosTime/src/CosTime_TimeService_impl.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2009. All Rights Reserved. +%% 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. @@ -107,6 +107,7 @@ universal_time(OE_THIS, State) -> %% Arguments: %% Returns : {'EXCEPTION", #'CosTime_TimeUnavailable'{}} %%----------------------------------------------------------- +-spec secure_universal_time(_, _) -> no_return(). secure_universal_time(_OE_THIS, _State) -> corba:raise(#'CosTime_TimeUnavailable'{}). diff --git a/lib/cosTime/test/Makefile b/lib/cosTime/test/Makefile index aabf855af5..003ea886a3 100644 --- a/lib/cosTime/test/Makefile +++ b/lib/cosTime/test/Makefile @@ -85,7 +85,6 @@ ERL_COMPILE_FLAGS += \ $(ERL_IDL_FLAGS) \ -pa $(ERL_TOP)/lib/orber/include \ -pa $(ERL_TOP)/lib/cosNotification/include \ - -pa $(ERL_TOP)/internal_tools/test_server/ebin \ -pa $(ERL_TOP)/lib/cosTime/ebin \ -pa $(ERL_TOP)/lib/cosTime/include \ -pa $(ERL_TOP)/lib/cosTime/test/idl_output \ @@ -94,8 +93,7 @@ ERL_COMPILE_FLAGS += \ -I$(ERL_TOP)/lib/cosTime/src \ -I$(ERL_TOP)/lib/cosTime/include \ -I$(ERL_TOP)/lib/cosTime \ - -I$(ERL_TOP)/lib/cosTime/test/$(IDLOUTDIR) \ - -I$(ERL_TOP)/lib/test_server/include + -I$(ERL_TOP)/lib/cosTime/test/$(IDLOUTDIR) # ---------------------------------------------------- # Targets diff --git a/lib/cosTime/test/generated_SUITE.erl b/lib/cosTime/test/generated_SUITE.erl index 2e63b6f50e..03dffedc05 100644 --- a/lib/cosTime/test/generated_SUITE.erl +++ b/lib/cosTime/test/generated_SUITE.erl @@ -26,7 +26,7 @@ -module(generated_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -define(default_timeout, ?t:minutes(3)). diff --git a/lib/cosTime/test/time_SUITE.erl b/lib/cosTime/test/time_SUITE.erl index 0e805aed05..7213680b99 100644 --- a/lib/cosTime/test/time_SUITE.erl +++ b/lib/cosTime/test/time_SUITE.erl @@ -30,7 +30,7 @@ %%--------------- INCLUDES ----------------------------------- -include_lib("cosTime/src/cosTimeApp.hrl"). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %%--------------- DEFINES ------------------------------------ -define(default_timeout, ?t:minutes(20)). diff --git a/lib/cosTransactions/src/CosTransactions_TransactionFactory_impl.erl b/lib/cosTransactions/src/CosTransactions_TransactionFactory_impl.erl index e0d14299a3..e24bcb9a04 100644 --- a/lib/cosTransactions/src/CosTransactions_TransactionFactory_impl.erl +++ b/lib/cosTransactions/src/CosTransactions_TransactionFactory_impl.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2015. 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. @@ -169,6 +169,7 @@ create(_Self, _State, _TimeOut) -> %% Effect : %%------------------------------------------------------------ +-spec recreate(_, _, _) -> no_return(). recreate(_Self, _State, #'CosTransactions_PropagationContext'{current = _C}) -> corba:raise(#'NO_IMPLEMENT'{completion_status=?COMPLETED_YES}). %recreate(Self, State, #'CosTransactions_PropagationContext'{current = C}) -> diff --git a/lib/cosTransactions/src/ETraP_Server_impl.erl b/lib/cosTransactions/src/ETraP_Server_impl.erl index 7b451e1762..5c7b5f6350 100644 --- a/lib/cosTransactions/src/ETraP_Server_impl.erl +++ b/lib/cosTransactions/src/ETraP_Server_impl.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2015. 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. @@ -675,6 +675,7 @@ is_same_transaction(Self, {Env, Local}, Coordinator) -> %% Effect : %%------------------------------------------------------------ +-spec is_related_transaction(_, _, _) -> no_return(). is_related_transaction(_Self, {_Env, _Local}, _Coordinator) -> corba:raise(#'NO_IMPLEMENT'{completion_status=?COMPLETED_YES}). % type_check(?tr_get_typeCheck(Env), ?tr_Coordinator, @@ -689,6 +690,7 @@ is_related_transaction(_Self, {_Env, _Local}, _Coordinator) -> %% Effect : %%------------------------------------------------------------ +-spec is_ancestor_transaction(_, _, _) -> no_return(). is_ancestor_transaction(_Self, {_Env, _Local}, _Coordinator) -> corba:raise(#'NO_IMPLEMENT'{completion_status=?COMPLETED_YES}). % type_check(?tr_get_typeCheck(Env), ?tr_Coordinator, @@ -826,6 +828,7 @@ register_subtran_aware(Self, {Env, Local}, SubTrAwareResource) -> %% Effect : %%------------------------------------------------------------ +-spec register_synchronization(_, _, _) -> no_return(). register_synchronization(_Self, {_Env, _Local}, _Synchronization) -> corba:raise(#'CosTransactions_SynchronizationUnavailable'{}). @@ -950,6 +953,7 @@ create_subtransaction(Self, {Env, Local}) -> %% Effect : %%------------------------------------------------------------ +-spec get_txcontext(_, _) -> no_return(). get_txcontext(_Self, {_Env, _Local}) -> corba:raise(#'CosTransactions_Unavailable'{}). diff --git a/lib/cosTransactions/test/Makefile b/lib/cosTransactions/test/Makefile index 3cdb05e7ef..9bcd461f04 100644 --- a/lib/cosTransactions/test/Makefile +++ b/lib/cosTransactions/test/Makefile @@ -93,13 +93,11 @@ ERL_IDL_FLAGS += -pa $(ERL_TOP)/lib/cosTransactions/ebin\ ERL_COMPILE_FLAGS += \ $(ERL_IDL_FLAGS) \ -pa $(ERL_TOP)/lib/orber/include \ - -pa $(ERL_TOP)/lib/test_server/ebin \ -pa $(ERL_TOP)/lib/cosTransactions/ebin \ -pa $(ERL_TOP)/lib/cosTransactions/test/idl_output \ -I$(ERL_TOP)/lib/orber/include \ -I$(ERL_TOP)/lib/cosTransactions \ - -I$(ERL_TOP)/lib/cosTransactions/test/$(IDLOUTDIR) \ - -I$(ERL_TOP)/lib/test_server/include + -I$(ERL_TOP)/lib/cosTransactions/test/$(IDLOUTDIR) # ---------------------------------------------------- # Targets diff --git a/lib/cosTransactions/test/generated_SUITE.erl b/lib/cosTransactions/test/generated_SUITE.erl index 9d5cfb154a..c4bd86a892 100644 --- a/lib/cosTransactions/test/generated_SUITE.erl +++ b/lib/cosTransactions/test/generated_SUITE.erl @@ -27,7 +27,7 @@ -module(generated_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -define(default_timeout, ?t:minutes(3)). diff --git a/lib/cosTransactions/test/transactions_SUITE.erl b/lib/cosTransactions/test/transactions_SUITE.erl index 0f06c3d262..63ec04f74f 100644 --- a/lib/cosTransactions/test/transactions_SUITE.erl +++ b/lib/cosTransactions/test/transactions_SUITE.erl @@ -29,7 +29,7 @@ -include_lib("cosTransactions/include/CosTransactions.hrl"). -include("etrap_test_lib.hrl"). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(default_timeout, ?t:minutes(20)). diff --git a/lib/crypto/Makefile b/lib/crypto/Makefile index 24db75bf91..fbf108c410 100644 --- a/lib/crypto/Makefile +++ b/lib/crypto/Makefile @@ -24,11 +24,7 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk # Macros # -ifneq ($(findstring ose,$(TARGET)),ose) SUB_DIRECTORIES = src c_src doc/src -else -SUB_DIRECTORIES = src doc/src -endif static_lib: SUB_DIRECTORIES = c_src include vsn.mk diff --git a/lib/crypto/c_src/Makefile.in b/lib/crypto/c_src/Makefile.in index e66c0ca916..e7f750b60a 100644 --- a/lib/crypto/c_src/Makefile.in +++ b/lib/crypto/c_src/Makefile.in @@ -127,12 +127,7 @@ ALL_STATIC_CFLAGS = $(DED_STATIC_CFLAGS) $(INCLUDES) _create_dirs := $(shell mkdir -p $(OBJDIR) $(LIBDIR)) -ifneq ($(findstring ose,$(TARGET)),ose) debug opt valgrind: $(NIF_LIB) $(CALLBACK_LIB) -else -# Do not build dynamic files on OSE -debug opt valgrind: -endif static_lib: $(NIF_ARCHIVE) @@ -203,14 +198,12 @@ release_spec: opt $(INSTALL_DIR) "$(RELSYSDIR)/priv/obj" $(INSTALL_DIR) "$(RELSYSDIR)/priv/lib" $(INSTALL_DATA) $(NIF_MAKEFILE) "$(RELSYSDIR)/priv/obj" -ifneq ($(findstring ose,$(TARGET)),ose) $(INSTALL_PROGRAM) $(CRYPTO_OBJS) "$(RELSYSDIR)/priv/obj" $(INSTALL_PROGRAM) $(NIF_LIB) "$(RELSYSDIR)/priv/lib" ifeq ($(DYNAMIC_CRYPTO_LIB),yes) $(INSTALL_PROGRAM) $(CALLBACK_OBJS) "$(RELSYSDIR)/priv/obj" $(INSTALL_PROGRAM) $(CALLBACK_LIB) "$(RELSYSDIR)/priv/lib" endif -endif release_docs_spec: diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index 9de8dc74c2..d1f620d892 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -91,6 +91,7 @@ #endif #if OPENSSL_VERSION_NUMBER >= 0x1000100fL +# define HAVE_EVP_AES_CTR # define HAVE_GCM #endif @@ -98,6 +99,10 @@ # define HAVE_CHACHA20_POLY1305 #endif +#if OPENSSL_VERSION_NUMBER <= 0x009080cfL +# define HAVE_ECB_IVEC_BUG +#endif + #if defined(HAVE_EC) #include <openssl/ec.h> #include <openssl/ecdh.h> @@ -193,57 +198,20 @@ static void unload(ErlNifEnv* env, void* priv_data); /* The NIFs: */ static ERL_NIF_TERM info_lib(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM algorithms(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM md5(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM md5_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM md5_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM md5_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM ripemd160(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM ripemd160_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM ripemd160_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM ripemd160_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha224_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha224_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha224_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha224_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha256_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha256_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha256_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha256_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha384_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha384_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha384_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha384_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha512_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha512_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha512_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha512_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM md4(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM md4_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM md4_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM md4_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM md5_mac_n(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha_mac_n(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha224_mac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha256_mac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha384_mac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha512_mac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM hmac_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM hmac_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM hmac_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM des_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM des_cfb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM des_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM des_ede3_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM des_ede3_cfb_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM hash_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM hash_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM hash_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM hash_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM hmac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM hmac_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM hmac_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM hmac_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM block_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM aes_cfb_8_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM aes_cfb_128_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM aes_ige_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM aes_ctr_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM aes_ctr_stream_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM aes_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rand_bytes_1(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM strong_rand_bytes_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rand_bytes_3(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); @@ -252,13 +220,10 @@ static ERL_NIF_TERM rand_uniform_nif(ErlNifEnv* env, int argc, const ERL_NIF_TER static ERL_NIF_TERM mod_exp_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM dss_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rsa_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM aes_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM aes_ige_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM do_exor(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rc4_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rc4_set_key(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rc4_encrypt_with_state(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM rc2_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM dss_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rsa_public_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); @@ -270,10 +235,6 @@ static ERL_NIF_TERM dh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_T static ERL_NIF_TERM srp_value_B_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM srp_user_secret_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM srp_host_secret_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM bf_cfb64_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM bf_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM bf_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM blowfish_ofb64_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM ec_key_generate(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM ecdsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); @@ -291,32 +252,7 @@ static ERL_NIF_TERM chacha20_poly1305_decrypt(ErlNifEnv* env, int argc, const ER /* helpers */ static void init_algorithms_types(ErlNifEnv*); static void init_digest_types(ErlNifEnv* env); -static void hmac_md5(unsigned char *key, int klen, - unsigned char *dbuf, int dlen, - unsigned char *hmacbuf); -static void hmac_sha1(unsigned char *key, int klen, - unsigned char *dbuf, int dlen, - unsigned char *hmacbuf); -#ifdef HAVE_SHA224 -static void hmac_sha224(unsigned char *key, int klen, - unsigned char *dbuf, int dlen, - unsigned char *hmacbuf); -#endif -#ifdef HAVE_SHA256 -static void hmac_sha256(unsigned char *key, int klen, - unsigned char *dbuf, int dlen, - unsigned char *hmacbuf); -#endif -#ifdef HAVE_SHA384 -static void hmac_sha384(unsigned char *key, int klen, - unsigned char *dbuf, int dlen, - unsigned char *hmacbuf); -#endif -#ifdef HAVE_SHA512 -static void hmac_sha512(unsigned char *key, int klen, - unsigned char *dbuf, int dlen, - unsigned char *hmacbuf); -#endif +static void init_cipher_types(ErlNifEnv* env); #ifdef HAVE_EC static EC_KEY* ec_key_new(ErlNifEnv* env, ERL_NIF_TERM curve_arg); static int term2point(ErlNifEnv* env, ERL_NIF_TERM term, @@ -328,60 +264,25 @@ static int library_refc = 0; /* number of users of this dynamic library */ static ErlNifFunc nif_funcs[] = { {"info_lib", 0, info_lib}, {"algorithms", 0, algorithms}, - {"md5", 1, md5}, - {"md5_init", 0, md5_init}, - {"md5_update", 2, md5_update}, - {"md5_final", 1, md5_final}, - {"ripemd160", 1, ripemd160}, - {"ripemd160_init", 0, ripemd160_init}, - {"ripemd160_update", 2, ripemd160_update}, - {"ripemd160_final", 1, ripemd160_final}, - {"sha", 1, sha}, - {"sha_init", 0, sha_init}, - {"sha_update", 2, sha_update}, - {"sha_final", 1, sha_final}, - {"sha224_nif", 1, sha224_nif}, - {"sha224_init_nif", 0, sha224_init_nif}, - {"sha224_update_nif", 2, sha224_update_nif}, - {"sha224_final_nif", 1, sha224_final_nif}, - {"sha256_nif", 1, sha256_nif}, - {"sha256_init_nif", 0, sha256_init_nif}, - {"sha256_update_nif", 2, sha256_update_nif}, - {"sha256_final_nif", 1, sha256_final_nif}, - {"sha384_nif", 1, sha384_nif}, - {"sha384_init_nif", 0, sha384_init_nif}, - {"sha384_update_nif", 2, sha384_update_nif}, - {"sha384_final_nif", 1, sha384_final_nif}, - {"sha512_nif", 1, sha512_nif}, - {"sha512_init_nif", 0, sha512_init_nif}, - {"sha512_update_nif", 2, sha512_update_nif}, - {"sha512_final_nif", 1, sha512_final_nif}, - {"md4", 1, md4}, - {"md4_init", 0, md4_init}, - {"md4_update", 2, md4_update}, - {"md4_final", 1, md4_final}, - {"md5_mac_n", 3, md5_mac_n}, - {"sha_mac_n", 3, sha_mac_n}, - {"sha224_mac_nif", 3, sha224_mac_nif}, - {"sha256_mac_nif", 3, sha256_mac_nif}, - {"sha384_mac_nif", 3, sha384_mac_nif}, - {"sha512_mac_nif", 3, sha512_mac_nif}, - {"hmac_init", 2, hmac_init}, - {"hmac_update", 2, hmac_update}, - {"hmac_final", 1, hmac_final}, - {"hmac_final_n", 2, hmac_final}, - {"des_cbc_crypt", 4, des_cbc_crypt}, - {"des_cfb_crypt", 4, des_cfb_crypt}, - {"des_ecb_crypt", 3, des_ecb_crypt}, - {"des_ede3_cbc_crypt", 6, des_ede3_cbc_crypt}, - {"des_ede3_cfb_crypt_nif", 6, des_ede3_cfb_crypt_nif}, - {"aes_cfb_8_crypt", 4, aes_cfb_8_crypt}, - {"aes_cfb_128_crypt", 4, aes_cfb_128_crypt}, + {"hash_nif", 2, hash_nif}, + {"hash_init_nif", 1, hash_init_nif}, + {"hash_update_nif", 2, hash_update_nif}, + {"hash_final_nif", 1, hash_final_nif}, + {"hmac_nif", 3, hmac_nif}, + {"hmac_nif", 4, hmac_nif}, + {"hmac_init_nif", 2, hmac_init_nif}, + {"hmac_update_nif", 2, hmac_update_nif}, + {"hmac_final_nif", 1, hmac_final_nif}, + {"hmac_final_nif", 2, hmac_final_nif}, + {"block_crypt_nif", 5, block_crypt_nif}, + {"block_crypt_nif", 4, block_crypt_nif}, + {"aes_ige_crypt_nif", 4, aes_ige_crypt_nif}, + {"aes_ctr_encrypt", 3, aes_ctr_encrypt}, {"aes_ctr_decrypt", 3, aes_ctr_encrypt}, + {"aes_ctr_stream_init", 2, aes_ctr_stream_init}, {"aes_ctr_stream_encrypt", 2, aes_ctr_stream_encrypt}, {"aes_ctr_stream_decrypt", 2, aes_ctr_stream_encrypt}, - {"aes_ecb_crypt", 3, aes_ecb_crypt}, {"rand_bytes", 1, rand_bytes_1}, {"strong_rand_bytes_nif", 1, strong_rand_bytes_nif}, {"rand_bytes", 3, rand_bytes_3}, @@ -390,13 +291,10 @@ static ErlNifFunc nif_funcs[] = { {"mod_exp_nif", 4, mod_exp_nif}, {"dss_verify_nif", 4, dss_verify_nif}, {"rsa_verify_nif", 4, rsa_verify_nif}, - {"aes_cbc_crypt", 4, aes_cbc_crypt}, - {"aes_ige_crypt_nif", 4, aes_ige_crypt_nif}, {"do_exor", 2, do_exor}, {"rc4_encrypt", 2, rc4_encrypt}, {"rc4_set_key", 1, rc4_set_key}, {"rc4_encrypt_with_state", 2, rc4_encrypt_with_state}, - {"rc2_cbc_crypt", 4, rc2_cbc_crypt}, {"rsa_sign_nif", 3, rsa_sign_nif}, {"dss_sign_nif", 3, dss_sign_nif}, {"rsa_public_crypt", 4, rsa_public_crypt}, @@ -408,10 +306,6 @@ static ErlNifFunc nif_funcs[] = { {"srp_value_B_nif", 5, srp_value_B_nif}, {"srp_user_secret_nif", 7, srp_user_secret_nif}, {"srp_host_secret_nif", 5, srp_host_secret_nif}, - {"bf_cfb64_crypt", 4, bf_cfb64_crypt}, - {"bf_cbc_crypt", 4, bf_cbc_crypt}, - {"bf_ecb_crypt", 3, bf_ecb_crypt}, - {"blowfish_ofb64_encrypt", 3, blowfish_ofb64_encrypt}, {"ec_key_generate", 2, ec_key_generate}, {"ecdsa_sign_nif", 4, ecdsa_sign_nif}, @@ -432,37 +326,14 @@ static ErlNifFunc nif_funcs[] = { ERL_NIF_INIT(crypto,nif_funcs,load,NULL,upgrade,unload) -#define MD5_CTX_LEN (sizeof(MD5_CTX)) -#define MD5_LEN 16 -#define MD5_LEN_96 12 -#define MD4_CTX_LEN (sizeof(MD4_CTX)) -#define MD4_LEN 16 +#define MD5_CTX_LEN (sizeof(MD5_CTX)) +#define MD4_CTX_LEN (sizeof(MD4_CTX)) #define RIPEMD160_CTX_LEN (sizeof(RIPEMD160_CTX)) -#define RIPEMD160_LEN 20 -#define SHA_CTX_LEN (sizeof(SHA_CTX)) -#define SHA_LEN 20 -#define SHA_LEN_96 12 -#define SHA224_LEN (224/8) -#define SHA256_LEN (256/8) -#define SHA384_LEN (384/8) -#define SHA512_LEN (512/8) -#define HMAC_INT_LEN 64 -#define HMAC_INT2_LEN 128 - -#define HMAC_IPAD 0x36 -#define HMAC_OPAD 0x5c static ERL_NIF_TERM atom_true; static ERL_NIF_TERM atom_false; static ERL_NIF_TERM atom_sha; -static ERL_NIF_TERM atom_sha224; -static ERL_NIF_TERM atom_sha256; -static ERL_NIF_TERM atom_sha384; -static ERL_NIF_TERM atom_sha512; -static ERL_NIF_TERM atom_md5; -static ERL_NIF_TERM atom_md4; -static ERL_NIF_TERM atom_ripemd160; static ERL_NIF_TERM atom_error; static ERL_NIF_TERM atom_rsa_pkcs1_padding; static ERL_NIF_TERM atom_rsa_pkcs1_oaep_padding; @@ -489,6 +360,14 @@ static ERL_NIF_TERM atom_ppbasis; static ERL_NIF_TERM atom_onbasis; #endif +static ERL_NIF_TERM atom_aes_cfb8; +static ERL_NIF_TERM atom_aes_cfb128; +#ifdef HAVE_ECB_IVEC_BUG +static ERL_NIF_TERM atom_aes_ecb; +static ERL_NIF_TERM atom_des_ecb; +static ERL_NIF_TERM atom_blowfish_ecb; +#endif + static ErlNifResourceType* hmac_context_rtype; struct hmac_context { @@ -498,6 +377,91 @@ struct hmac_context }; static void hmac_context_dtor(ErlNifEnv* env, struct hmac_context*); +struct digest_type_t { + const char* type_str; + const EVP_MD* (*md_func)(void); /* NULL if notsup */ + ERL_NIF_TERM type_atom; +}; + +struct digest_type_t digest_types[] = +{ + {"md4", &EVP_md4}, + {"md5", &EVP_md5}, + {"ripemd160", &EVP_ripemd160}, + {"sha", &EVP_sha1}, + {"sha224", +#ifdef HAVE_SHA224 + &EVP_sha224 +#else + NULL +#endif + }, + {"sha256", +#ifdef HAVE_SHA256 + &EVP_sha256 +#else + NULL +#endif + }, + {"sha384", +#ifdef HAVE_SHA384 + &EVP_sha384 +#else + NULL +#endif + }, + {"sha512", +#ifdef HAVE_SHA512 + &EVP_sha512 +#else + NULL +#endif + }, + {NULL} +}; + +static struct digest_type_t* get_digest_type(ERL_NIF_TERM type); + +struct cipher_type_t { + const char* type_str; + const EVP_CIPHER* (*cipher_func)(void); /* NULL if notsup */ + const size_t key_len; /* != 0 to also match on key_len */ + ERL_NIF_TERM type_atom; +}; + +struct cipher_type_t cipher_types[] = +{ + {"rc2_cbc", &EVP_rc2_cbc}, + {"des_cbc", &EVP_des_cbc}, + {"des_cfb", &EVP_des_cfb8}, + {"des_ecb", &EVP_des_ecb}, + {"des_ede3_cbc", &EVP_des_ede3_cbc}, + {"des_ede3_cbf", +#ifdef HAVE_DES_ede3_cfb_encrypt + &EVP_des_ede3_cfb8 +#else + NULL +#endif + }, + {"blowfish_cbc", &EVP_bf_cbc}, + {"blowfish_cfb64", &EVP_bf_cfb64}, + {"blowfish_ofb64", &EVP_bf_ofb}, + {"blowfish_ecb", &EVP_bf_ecb}, + {"aes_cbc", &EVP_aes_128_cbc, 16}, + {"aes_cbc", &EVP_aes_192_cbc, 24}, + {"aes_cbc", &EVP_aes_256_cbc, 32}, + {"aes_cbc128", &EVP_aes_128_cbc}, + {"aes_cbc256", &EVP_aes_256_cbc}, + {"aes_cfb8", &EVP_aes_128_cfb8}, + {"aes_cfb128", &EVP_aes_128_cfb128}, + {"aes_ecb", &EVP_aes_128_ecb, 16}, + {"aes_ecb", &EVP_aes_192_ecb, 24}, + {"aes_ecb", &EVP_aes_256_ecb, 32}, + {NULL} +}; + +static struct cipher_type_t* get_cipher_type(ERL_NIF_TERM type, size_t key_len); + /* #define PRINTF_ERR0(FMT) enif_fprintf(stderr, FMT "\n") #define PRINTF_ERR1(FMT, A1) enif_fprintf(stderr, FMT "\n", A1) @@ -507,47 +471,21 @@ static void hmac_context_dtor(ErlNifEnv* env, struct hmac_context*); #define PRINTF_ERR1(FMT,A1) #define PRINTF_ERR2(FMT,A1,A2) -#ifdef __OSE__ - -/* For crypto on OSE we have to initialize the crypto library on each - process that uses it. So since we do not know which scheduler is going - to execute the nif we have to check before each nif call that we have - initialized crypto in that process. */ - -#include "ose.h" -#include "openssl/osessl.h" - -static ErlNifTSDKey crypto_init_key; -static int check_ose_crypto(void); -static int init_ose_crypto(void); - -static int check_ose_crypto() { - int key = (int)enif_tsd_get(crypto_init_key); - if (!key) { - if (!CRYPTO_OSE5_init()) { - PRINTF_ERR0("CRYPTO: Call to CRYPTO_OSE5_init failed"); - return 0; - } - enif_tsd_set(crypto_init_key,1); - } - return 1; +#if OPENSSL_VERSION_NUMBER >= 0x1000000fL +/* Define resource types for OpenSSL context structures. */ +static ErlNifResourceType* evp_md_ctx_rtype; +static void evp_md_ctx_dtor(ErlNifEnv* env, EVP_MD_CTX* ctx) { + EVP_MD_CTX_cleanup(ctx); } +#endif -static int init_ose_crypto() { - /* Crypto nif upgrade does not work on OSE so no need to - destroy this key */ - enif_tsd_key_create("crypto_init_key", &crypto_init_key); - return check_ose_crypto(); +#ifdef HAVE_EVP_AES_CTR +static ErlNifResourceType* evp_cipher_ctx_rtype; +static void evp_cipher_ctx_dtor(ErlNifEnv* env, EVP_CIPHER_CTX* ctx) { + EVP_CIPHER_CTX_cleanup(ctx); } - -#define INIT_OSE_CRYPTO() init_ose_crypto() -#define CHECK_OSE_CRYPTO() check_ose_crypto() -#else -#define INIT_OSE_CRYPTO() 1 -#define CHECK_OSE_CRYPTO() #endif - static int verify_lib_version(void) { const unsigned long libv = SSLeay(); @@ -563,7 +501,6 @@ static int verify_lib_version(void) return 1; } - #ifdef HAVE_DYNAMIC_CRYPTO_LIB # if defined(DEBUG) @@ -599,7 +536,9 @@ static void error_handler(void* null, const char* errstr) static int init(ErlNifEnv* env, ERL_NIF_TERM load_info) { +#ifdef OPENSSL_THREADS ErlNifSysInfo sys_info; +#endif get_crypto_callbacks_t* funcp; struct crypto_callbacks* ccb; int nlocks = 0; @@ -609,9 +548,6 @@ static int init(ErlNifEnv* env, ERL_NIF_TERM load_info) ErlNifBinary lib_bin; char lib_buf[1000]; - if (!INIT_OSE_CRYPTO()) - return 0; - if (!verify_lib_version()) return 0; @@ -634,7 +570,26 @@ static int init(ErlNifEnv* env, ERL_NIF_TERM load_info) PRINTF_ERR0("CRYPTO: Could not open resource type 'hmac_context'"); return 0; } - +#if OPENSSL_VERSION_NUMBER >= 0x1000000fL + evp_md_ctx_rtype = enif_open_resource_type(env, NULL, "EVP_MD_CTX", + (ErlNifResourceDtor*) evp_md_ctx_dtor, + ERL_NIF_RT_CREATE|ERL_NIF_RT_TAKEOVER, + NULL); + if (!evp_md_ctx_rtype) { + PRINTF_ERR0("CRYPTO: Could not open resource type 'EVP_MD_CTX'"); + return 0; + } +#endif +#ifdef HAVE_EVP_AES_CTR + evp_cipher_ctx_rtype = enif_open_resource_type(env, NULL, "EVP_CIPHER_CTX", + (ErlNifResourceDtor*) evp_cipher_ctx_dtor, + ERL_NIF_RT_CREATE|ERL_NIF_RT_TAKEOVER, + NULL); + if (!evp_cipher_ctx_rtype) { + PRINTF_ERR0("CRYPTO: Could not open resource type 'EVP_CIPHER_CTX'"); + return 0; + } +#endif if (library_refc > 0) { /* Repeated loading of this library (module upgrade). * Atoms and callbacks are already set, we are done. @@ -642,16 +597,9 @@ static int init(ErlNifEnv* env, ERL_NIF_TERM load_info) return 1; } - atom_true = enif_make_atom(env,"true"); + atom_true = enif_make_atom(env,"true"); atom_false = enif_make_atom(env,"false"); atom_sha = enif_make_atom(env,"sha"); - atom_sha224 = enif_make_atom(env,"sha224"); - atom_sha256 = enif_make_atom(env,"sha256"); - atom_sha384 = enif_make_atom(env,"sha384"); - atom_sha512 = enif_make_atom(env,"sha512"); - atom_md4 = enif_make_atom(env,"md4"); - atom_md5 = enif_make_atom(env,"md5"); - atom_ripemd160 = enif_make_atom(env,"ripemd160"); atom_error = enif_make_atom(env,"error"); atom_rsa_pkcs1_padding = enif_make_atom(env,"rsa_pkcs1_padding"); atom_rsa_pkcs1_oaep_padding = enif_make_atom(env,"rsa_pkcs1_oaep_padding"); @@ -676,8 +624,16 @@ static int init(ErlNifEnv* env, ERL_NIF_TERM load_info) atom_ppbasis = enif_make_atom(env,"ppbasis"); atom_onbasis = enif_make_atom(env,"onbasis"); #endif + atom_aes_cfb8 = enif_make_atom(env, "aes_cfb8"); + atom_aes_cfb128 = enif_make_atom(env, "aes_cfb128"); +#ifdef HAVE_ECB_IVEC_BUG + atom_aes_ecb = enif_make_atom(env, "aes_ecb"); + atom_des_ecb = enif_make_atom(env, "des_ecb"); + atom_blowfish_ecb = enif_make_atom(env, "blowfish_ecb"); +#endif init_digest_types(env); + init_cipher_types(env); init_algorithms_types(env); #ifdef HAVE_DYNAMIC_CRYPTO_LIB @@ -762,46 +718,67 @@ static void unload(ErlNifEnv* env, void* priv_data) static int algo_hash_cnt; static ERL_NIF_TERM algo_hash[8]; /* increase when extending the list */ static int algo_pubkey_cnt; -static ERL_NIF_TERM algo_pubkey[3]; /* increase when extending the list */ +static ERL_NIF_TERM algo_pubkey[7]; /* increase when extending the list */ static int algo_cipher_cnt; -static ERL_NIF_TERM algo_cipher[4]; /* increase when extending the list */ +static ERL_NIF_TERM algo_cipher[20]; /* increase when extending the list */ static void init_algorithms_types(ErlNifEnv* env) { algo_hash_cnt = 0; - algo_hash[algo_hash_cnt++] = atom_md4; - algo_hash[algo_hash_cnt++] = atom_md5; algo_hash[algo_hash_cnt++] = atom_sha; - algo_hash[algo_hash_cnt++] = atom_ripemd160; #ifdef HAVE_SHA224 - algo_hash[algo_hash_cnt++] = atom_sha224; + algo_hash[algo_hash_cnt++] = enif_make_atom(env, "sha224"); #endif #ifdef HAVE_SHA256 - algo_hash[algo_hash_cnt++] = atom_sha256; + algo_hash[algo_hash_cnt++] = enif_make_atom(env, "sha256"); #endif #ifdef HAVE_SHA384 - algo_hash[algo_hash_cnt++] = atom_sha384; + algo_hash[algo_hash_cnt++] = enif_make_atom(env, "sha384"); #endif #ifdef HAVE_SHA512 - algo_hash[algo_hash_cnt++] = atom_sha512; + algo_hash[algo_hash_cnt++] = enif_make_atom(env, "sha512"); #endif + algo_hash[algo_hash_cnt++] = enif_make_atom(env, "md4"); + algo_hash[algo_hash_cnt++] = enif_make_atom(env, "md5"); + algo_hash[algo_hash_cnt++] = enif_make_atom(env, "ripemd160"); algo_pubkey_cnt = 0; + algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env, "rsa"); + algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env, "dss"); + algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env, "dh"); #if defined(HAVE_EC) #if !defined(OPENSSL_NO_EC2M) - algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env,"ec_gf2m"); + algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env, "ec_gf2m"); #endif - algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env,"ecdsa"); - algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env,"ecdh"); + algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env, "ecdsa"); + algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env, "ecdh"); #endif + algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env, "srp"); algo_cipher_cnt = 0; + algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "des3_cbc"); + algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "des_ede3"); #ifdef HAVE_DES_ede3_cfb_encrypt algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "des3_cbf"); #endif + algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "aes_cbc"); + algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "aes_cbc128"); + algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "aes_cfb8"); + algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "aes_cfb128"); + algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "aes_cbc256"); + algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "aes_ctr"); + algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "aes_ecb"); #ifdef HAVE_AES_IGE algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"aes_ige256"); #endif + algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"des_cbc"); + algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"des_cfb"); + algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"blowfish_cbc"); + algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"blowfish_cfb64"); + algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"blowfish_ofb64"); + algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"blowfish_ecb"); + algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"rc2_cbc"); + algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"rc4"); #if defined(HAVE_GCM) algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"aes_gcm"); #endif @@ -816,10 +793,13 @@ static void init_algorithms_types(ErlNifEnv* env) static ERL_NIF_TERM algorithms(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { + int hash_cnt = algo_hash_cnt; + int pubkey_cnt = algo_pubkey_cnt; + int cipher_cnt = algo_cipher_cnt; return enif_make_tuple3(env, - enif_make_list_from_array(env, algo_hash, algo_hash_cnt), - enif_make_list_from_array(env, algo_pubkey, algo_pubkey_cnt), - enif_make_list_from_array(env, algo_cipher, algo_cipher_cnt)); + enif_make_list_from_array(env, algo_hash, hash_cnt), + enif_make_list_from_array(env, algo_pubkey, pubkey_cnt), + enif_make_list_from_array(env, algo_cipher, cipher_cnt)); } static ERL_NIF_TERM info_lib(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) @@ -849,601 +829,383 @@ static ERL_NIF_TERM info_lib(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] ver_term)); } -static ERL_NIF_TERM md5(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Data) */ - ErlNifBinary ibin; - ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - if (!enif_inspect_iolist_as_binary(env, argv[0], &ibin)) { - return enif_make_badarg(env); - } - MD5((unsigned char *) ibin.data, ibin.size, - enif_make_new_binary(env,MD5_LEN, &ret)); - CONSUME_REDS(env,ibin); - return ret; -} -static ERL_NIF_TERM md5_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* () */ - ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - MD5_Init((MD5_CTX *) enif_make_new_binary(env, MD5_CTX_LEN, &ret)); - return ret; -} -static ERL_NIF_TERM md5_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Context, Data) */ - MD5_CTX* new_ctx; - ErlNifBinary ctx_bin, data_bin; - ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - if (!enif_inspect_binary(env, argv[0], &ctx_bin) - || ctx_bin.size != MD5_CTX_LEN - || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) { +static ERL_NIF_TERM hash_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Type, Data) */ + struct digest_type_t *digp = NULL; + const EVP_MD *md; + ErlNifBinary data; + ERL_NIF_TERM ret; + unsigned ret_size; + + digp = get_digest_type(argv[0]); + if (!digp || + !enif_inspect_iolist_as_binary(env, argv[1], &data)) { return enif_make_badarg(env); } - new_ctx = (MD5_CTX*) enif_make_new_binary(env,MD5_CTX_LEN, &ret); - memcpy(new_ctx, ctx_bin.data, MD5_CTX_LEN); - MD5_Update(new_ctx, data_bin.data, data_bin.size); - CONSUME_REDS(env,data_bin); - return ret; -} -static ERL_NIF_TERM md5_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Context) */ - ErlNifBinary ctx_bin; - MD5_CTX ctx_clone; - ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != MD5_CTX_LEN) { - return enif_make_badarg(env); + if (!digp->md_func) { + return atom_notsup; } - memcpy(&ctx_clone, ctx_bin.data, MD5_CTX_LEN); /* writable */ - MD5_Final(enif_make_new_binary(env, MD5_LEN, &ret), &ctx_clone); - return ret; -} -static ERL_NIF_TERM ripemd160(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Data) */ - ErlNifBinary ibin; - ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - if (!enif_inspect_iolist_as_binary(env, argv[0], &ibin)) { - return enif_make_badarg(env); + md = digp->md_func(); + ret_size = (unsigned)EVP_MD_size(md); + ASSERT(0 < ret_size && ret_size <= EVP_MAX_MD_SIZE); + if (!EVP_Digest(data.data, data.size, + enif_make_new_binary(env, ret_size, &ret), &ret_size, + md, NULL)) { + return atom_notsup; } - RIPEMD160((unsigned char *) ibin.data, ibin.size, - enif_make_new_binary(env,RIPEMD160_LEN, &ret)); - CONSUME_REDS(env,ibin); - return ret; -} -static ERL_NIF_TERM ripemd160_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* () */ - ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - RIPEMD160_Init((RIPEMD160_CTX *) enif_make_new_binary(env, RIPEMD160_CTX_LEN, &ret)); + ASSERT(ret_size == (unsigned)EVP_MD_size(md)); + + CONSUME_REDS(env, data); return ret; } -static ERL_NIF_TERM ripemd160_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Context, Data) */ - RIPEMD160_CTX* new_ctx; - ErlNifBinary ctx_bin, data_bin; - ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - if (!enif_inspect_binary(env, argv[0], &ctx_bin) - || ctx_bin.size != RIPEMD160_CTX_LEN - || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) { + +#if OPENSSL_VERSION_NUMBER >= 0x1000000fL + +static ERL_NIF_TERM hash_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Type) */ + struct digest_type_t *digp = NULL; + EVP_MD_CTX *ctx; + ERL_NIF_TERM ret; + + digp = get_digest_type(argv[0]); + if (!digp) { return enif_make_badarg(env); } - new_ctx = (RIPEMD160_CTX*) enif_make_new_binary(env,RIPEMD160_CTX_LEN, &ret); - memcpy(new_ctx, ctx_bin.data, RIPEMD160_CTX_LEN); - RIPEMD160_Update(new_ctx, data_bin.data, data_bin.size); - CONSUME_REDS(env, data_bin); - return ret; -} -static ERL_NIF_TERM ripemd160_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Context) */ - ErlNifBinary ctx_bin; - RIPEMD160_CTX ctx_clone; - ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != RIPEMD160_CTX_LEN) { - return enif_make_badarg(env); + if (!digp->md_func) { + return atom_notsup; } - memcpy(&ctx_clone, ctx_bin.data, RIPEMD160_CTX_LEN); /* writable */ - RIPEMD160_Final(enif_make_new_binary(env, RIPEMD160_LEN, &ret), &ctx_clone); - return ret; -} - -static ERL_NIF_TERM sha(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Data) */ - ErlNifBinary ibin; - ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - if (!enif_inspect_iolist_as_binary(env, argv[0], &ibin)) { - return enif_make_badarg(env); + ctx = enif_alloc_resource(evp_md_ctx_rtype, sizeof(EVP_MD_CTX)); + if (!EVP_DigestInit(ctx, digp->md_func())) { + enif_release_resource(ctx); + return atom_notsup; } - SHA1((unsigned char *) ibin.data, ibin.size, - enif_make_new_binary(env,SHA_LEN, &ret)); - CONSUME_REDS(env,ibin); - return ret; -} -static ERL_NIF_TERM sha_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* () */ - ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - SHA1_Init((SHA_CTX *) enif_make_new_binary(env, SHA_CTX_LEN, &ret)); + ret = enif_make_resource(env, ctx); + enif_release_resource(ctx); return ret; } -static ERL_NIF_TERM sha_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +static ERL_NIF_TERM hash_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Context, Data) */ - SHA_CTX* new_ctx; - ErlNifBinary ctx_bin, data_bin; + EVP_MD_CTX *ctx, *new_ctx; + ErlNifBinary data; ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != SHA_CTX_LEN - || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) { - return enif_make_badarg(env); + + if (!enif_get_resource(env, argv[0], evp_md_ctx_rtype, (void**)&ctx) || + !enif_inspect_iolist_as_binary(env, argv[1], &data)) { + return enif_make_badarg(env); } - new_ctx = (SHA_CTX*) enif_make_new_binary(env,SHA_CTX_LEN, &ret); - memcpy(new_ctx, ctx_bin.data, SHA_CTX_LEN); - SHA1_Update(new_ctx, data_bin.data, data_bin.size); - CONSUME_REDS(env,data_bin); + + new_ctx = enif_alloc_resource(evp_md_ctx_rtype, sizeof(EVP_MD_CTX)); + if (!EVP_MD_CTX_copy(new_ctx, ctx) || + !EVP_DigestUpdate(new_ctx, data.data, data.size)) { + enif_release_resource(new_ctx); + return atom_notsup; + } + + ret = enif_make_resource(env, new_ctx); + enif_release_resource(new_ctx); + CONSUME_REDS(env, data); return ret; } -static ERL_NIF_TERM sha_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +static ERL_NIF_TERM hash_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Context) */ - ErlNifBinary ctx_bin; - SHA_CTX ctx_clone; - ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != SHA_CTX_LEN) { - return enif_make_badarg(env); + EVP_MD_CTX *ctx, new_ctx; + ERL_NIF_TERM ret; + unsigned ret_size; + + if (!enif_get_resource(env, argv[0], evp_md_ctx_rtype, (void**)&ctx)) { + return enif_make_badarg(env); } - memcpy(&ctx_clone, ctx_bin.data, SHA_CTX_LEN); /* writable */ - SHA1_Final(enif_make_new_binary(env, SHA_LEN, &ret), &ctx_clone); - return ret; -} -static ERL_NIF_TERM sha224_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Data) */ -#ifdef HAVE_SHA224 - ErlNifBinary ibin; - ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - if (!enif_inspect_iolist_as_binary(env, argv[0], &ibin)) { - return enif_make_badarg(env); + ret_size = (unsigned)EVP_MD_CTX_size(ctx); + ASSERT(0 < ret_size && ret_size <= EVP_MAX_MD_SIZE); + + if (!EVP_MD_CTX_copy(&new_ctx, ctx) || + !EVP_DigestFinal(&new_ctx, + enif_make_new_binary(env, ret_size, &ret), + &ret_size)) { + return atom_notsup; } - SHA224((unsigned char *) ibin.data, ibin.size, - enif_make_new_binary(env,SHA224_LEN, &ret)); - CONSUME_REDS(env,ibin); + ASSERT(ret_size == (unsigned)EVP_MD_CTX_size(ctx)); + return ret; -#else - return atom_notsup; -#endif } -static ERL_NIF_TERM sha224_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* () */ -#ifdef HAVE_SHA224 - ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - SHA224_Init((SHA256_CTX *) enif_make_new_binary(env, sizeof(SHA256_CTX), &ret)); - return ret; -#else - return atom_notsup; -#endif -} -static ERL_NIF_TERM sha224_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Context, Data) */ -#ifdef HAVE_SHA224 - SHA256_CTX* new_ctx; - ErlNifBinary ctx_bin, data_bin; - ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != sizeof(SHA256_CTX) - || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) { + +#else /* if OPENSSL_VERSION_NUMBER < 1.0 */ + +static ERL_NIF_TERM hash_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Type) */ + typedef int (*init_fun)(unsigned char*); + struct digest_type_t *digp = NULL; + ERL_NIF_TERM ctx; + size_t ctx_size = 0; + init_fun ctx_init = 0; + + digp = get_digest_type(argv[0]); + if (!digp) { return enif_make_badarg(env); } - new_ctx = (SHA256_CTX*) enif_make_new_binary(env,sizeof(SHA256_CTX), &ret); - memcpy(new_ctx, ctx_bin.data, sizeof(SHA256_CTX)); - SHA224_Update(new_ctx, data_bin.data, data_bin.size); - CONSUME_REDS(env,data_bin); - return ret; -#else - return atom_notsup; -#endif -} -static ERL_NIF_TERM sha224_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Context) */ -#ifdef HAVE_SHA224 - ErlNifBinary ctx_bin; - SHA256_CTX ctx_clone; - ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != sizeof(SHA256_CTX)) { - return enif_make_badarg(env); + if (!digp->md_func) { + return atom_notsup; } - memcpy(&ctx_clone, ctx_bin.data, sizeof(SHA256_CTX)); /* writable */ - SHA224_Final(enif_make_new_binary(env, SHA224_LEN, &ret), &ctx_clone); - return ret; -#else - return atom_notsup; -#endif -} -static ERL_NIF_TERM sha256_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Data) */ -#ifdef HAVE_SHA256 - ErlNifBinary ibin; - ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - if (!enif_inspect_iolist_as_binary(env, argv[0], &ibin)) { - return enif_make_badarg(env); - } - SHA256((unsigned char *) ibin.data, ibin.size, - enif_make_new_binary(env,SHA256_LEN, &ret)); - CONSUME_REDS(env,ibin); - return ret; -#else - return atom_notsup; + switch (EVP_MD_type(digp->md_func())) + { + case NID_md4: + ctx_size = MD4_CTX_LEN; + ctx_init = (init_fun)(&MD4_Init); + break; + case NID_md5: + ctx_size = MD5_CTX_LEN; + ctx_init = (init_fun)(&MD5_Init); + break; + case NID_ripemd160: + ctx_size = RIPEMD160_CTX_LEN; + ctx_init = (init_fun)(&RIPEMD160_Init); + break; + case NID_sha1: + ctx_size = sizeof(SHA_CTX); + ctx_init = (init_fun)(&SHA1_Init); + break; +#ifdef HAVE_SHA224 + case NID_sha224: + ctx_size = sizeof(SHA256_CTX); + ctx_init = (init_fun)(&SHA224_Init); + break; #endif -} -static ERL_NIF_TERM sha256_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* () */ #ifdef HAVE_SHA256 - ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - SHA256_Init((SHA256_CTX *) enif_make_new_binary(env, sizeof(SHA256_CTX), &ret)); - return ret; -#else - return atom_notsup; + case NID_sha256: + ctx_size = sizeof(SHA256_CTX); + ctx_init = (init_fun)(&SHA256_Init); + break; #endif -} -static ERL_NIF_TERM sha256_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Context, Data) */ -#ifdef HAVE_SHA256 - SHA256_CTX* new_ctx; - ErlNifBinary ctx_bin, data_bin; - ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != sizeof(SHA256_CTX) - || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) { - return enif_make_badarg(env); +#ifdef HAVE_SHA384 + case NID_sha384: + ctx_size = sizeof(SHA512_CTX); + ctx_init = (init_fun)(&SHA384_Init); + break; +#endif +#ifdef HAVE_SHA512 + case NID_sha512: + ctx_size = sizeof(SHA512_CTX); + ctx_init = (init_fun)(&SHA512_Init); + break; +#endif + default: + return atom_notsup; + } + ASSERT(ctx_size); + ASSERT(ctx_init); + + ctx_init(enif_make_new_binary(env, ctx_size, &ctx)); + return enif_make_tuple2(env, argv[0], ctx); +} +static ERL_NIF_TERM hash_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* ({Type, Context}, Data) */ + typedef int (*update_fun)(unsigned char*, const unsigned char*, size_t); + ERL_NIF_TERM new_ctx; + ErlNifBinary ctx, data; + const ERL_NIF_TERM *tuple; + int arity; + struct digest_type_t *digp = NULL; + unsigned char *ctx_buff; + size_t ctx_size = 0; + update_fun ctx_update = 0; + + if (!enif_get_tuple(env, argv[0], &arity, &tuple) || + arity != 2 || + !(digp = get_digest_type(tuple[0])) || + !enif_inspect_binary(env, tuple[1], &ctx) || + !enif_inspect_iolist_as_binary(env, argv[1], &data)) { + return enif_make_badarg(env); } - new_ctx = (SHA256_CTX*) enif_make_new_binary(env,sizeof(SHA256_CTX), &ret); - memcpy(new_ctx, ctx_bin.data, sizeof(SHA256_CTX)); - SHA256_Update(new_ctx, data_bin.data, data_bin.size); - CONSUME_REDS(env,data_bin); - return ret; -#else - return atom_notsup; + if (!digp->md_func) { + return atom_notsup; + } + + switch (EVP_MD_type(digp->md_func())) + { + case NID_md4: + ctx_size = MD4_CTX_LEN; + ctx_update = (update_fun)(&MD4_Update); + break; + case NID_md5: + ctx_size = MD5_CTX_LEN; + ctx_update = (update_fun)(&MD5_Update); + break; + case NID_ripemd160: + ctx_size = RIPEMD160_CTX_LEN; + ctx_update = (update_fun)(&RIPEMD160_Update); + break; + case NID_sha1: + ctx_size = sizeof(SHA_CTX); + ctx_update = (update_fun)(&SHA1_Update); + break; +#ifdef HAVE_SHA224 + case NID_sha224: + ctx_size = sizeof(SHA256_CTX); + ctx_update = (update_fun)(&SHA224_Update); + break; #endif -} -static ERL_NIF_TERM sha256_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Context) */ #ifdef HAVE_SHA256 - ErlNifBinary ctx_bin; - SHA256_CTX ctx_clone; - ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != sizeof(SHA256_CTX)) { - return enif_make_badarg(env); - } - memcpy(&ctx_clone, ctx_bin.data, sizeof(SHA256_CTX)); /* writable */ - SHA256_Final(enif_make_new_binary(env, SHA256_LEN, &ret), &ctx_clone); - return ret; -#else - return atom_notsup; + case NID_sha256: + ctx_size = sizeof(SHA256_CTX); + ctx_update = (update_fun)(&SHA256_Update); + break; #endif -} - -static ERL_NIF_TERM sha384_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Data) */ #ifdef HAVE_SHA384 - ErlNifBinary ibin; - ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - if (!enif_inspect_iolist_as_binary(env, argv[0], &ibin)) { - return enif_make_badarg(env); - } - SHA384((unsigned char *) ibin.data, ibin.size, - enif_make_new_binary(env,SHA384_LEN, &ret)); - CONSUME_REDS(env,ibin); - return ret; -#else - return atom_notsup; + case NID_sha384: + ctx_size = sizeof(SHA512_CTX); + ctx_update = (update_fun)(&SHA384_Update); + break; #endif -} -static ERL_NIF_TERM sha384_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* () */ -#ifdef HAVE_SHA384 - ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - SHA384_Init((SHA512_CTX *) enif_make_new_binary(env, sizeof(SHA512_CTX), &ret)); - return ret; -#else - return atom_notsup; +#ifdef HAVE_SHA512 + case NID_sha512: + ctx_size = sizeof(SHA512_CTX); + ctx_update = (update_fun)(&SHA512_Update); + break; #endif -} -static ERL_NIF_TERM sha384_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Context, Data) */ -#ifdef HAVE_SHA384 - SHA512_CTX* new_ctx; - ErlNifBinary ctx_bin, data_bin; - ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != sizeof(SHA512_CTX) - || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) { - return enif_make_badarg(env); + default: + return atom_notsup; } - new_ctx = (SHA512_CTX*) enif_make_new_binary(env,sizeof(SHA512_CTX), &ret); - memcpy(new_ctx, ctx_bin.data, sizeof(SHA512_CTX)); - SHA384_Update(new_ctx, data_bin.data, data_bin.size); - CONSUME_REDS(env,data_bin); - return ret; -#else - return atom_notsup; -#endif -} -static ERL_NIF_TERM sha384_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Context) */ -#ifdef HAVE_SHA384 - ErlNifBinary ctx_bin; - SHA512_CTX ctx_clone; - ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != sizeof(SHA512_CTX)) { - return enif_make_badarg(env); + ASSERT(ctx_size); + ASSERT(ctx_update); + + if (ctx.size != ctx_size) { + return enif_make_badarg(env); } - memcpy(&ctx_clone, ctx_bin.data, sizeof(SHA512_CTX)); /* writable */ - SHA384_Final(enif_make_new_binary(env, SHA384_LEN, &ret), &ctx_clone); - return ret; -#else - return atom_notsup; -#endif -} -static ERL_NIF_TERM sha512_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Data) */ -#ifdef HAVE_SHA512 - ErlNifBinary ibin; - ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - if (!enif_inspect_iolist_as_binary(env, argv[0], &ibin)) { - return enif_make_badarg(env); + ctx_buff = enif_make_new_binary(env, ctx_size, &new_ctx); + memcpy(ctx_buff, ctx.data, ctx_size); + ctx_update(ctx_buff, data.data, data.size); + + CONSUME_REDS(env, data); + return enif_make_tuple2(env, tuple[0], new_ctx); +} +static ERL_NIF_TERM hash_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* ({Type, Context}) */ + typedef int (*final_fun)(unsigned char*, void*); + ERL_NIF_TERM ret; + ErlNifBinary ctx; + const ERL_NIF_TERM *tuple; + int arity; + struct digest_type_t *digp = NULL; + const EVP_MD *md; + void *new_ctx; + size_t ctx_size = 0; + final_fun ctx_final = 0; + + if (!enif_get_tuple(env, argv[0], &arity, &tuple) || + arity != 2 || + !(digp = get_digest_type(tuple[0])) || + !enif_inspect_binary(env, tuple[1], &ctx)) { + return enif_make_badarg(env); } - SHA512((unsigned char *) ibin.data, ibin.size, - enif_make_new_binary(env,SHA512_LEN, &ret)); - CONSUME_REDS(env,ibin); - return ret; -#else - return atom_notsup; + if (!digp->md_func) { + return atom_notsup; + } + + md = digp->md_func(); + + switch (EVP_MD_type(md)) + { + case NID_md4: + ctx_size = MD4_CTX_LEN; + ctx_final = (final_fun)(&MD4_Final); + break; + case NID_md5: + ctx_size = MD5_CTX_LEN; + ctx_final = (final_fun)(&MD5_Final); + break; + case NID_ripemd160: + ctx_size = RIPEMD160_CTX_LEN; + ctx_final = (final_fun)(&RIPEMD160_Final); + break; + case NID_sha1: + ctx_size = sizeof(SHA_CTX); + ctx_final = (final_fun)(&SHA1_Final); + break; +#ifdef HAVE_SHA224 + case NID_sha224: + ctx_size = sizeof(SHA256_CTX); + ctx_final = (final_fun)(&SHA224_Final); + break; #endif -} -static ERL_NIF_TERM sha512_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* () */ -#ifdef HAVE_SHA512 - ERL_NIF_TERM ret; - SHA512_Init((SHA512_CTX *) enif_make_new_binary(env, sizeof(SHA512_CTX), &ret)); - return ret; -#else - return atom_notsup; +#ifdef HAVE_SHA256 + case NID_sha256: + ctx_size = sizeof(SHA256_CTX); + ctx_final = (final_fun)(&SHA256_Final); + break; #endif -} -static ERL_NIF_TERM sha512_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Context, Data) */ -#ifdef HAVE_SHA512 - SHA512_CTX* new_ctx; - ErlNifBinary ctx_bin, data_bin; - ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != sizeof(SHA512_CTX) - || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) { - return enif_make_badarg(env); - } - new_ctx = (SHA512_CTX*) enif_make_new_binary(env,sizeof(SHA512_CTX), &ret); - memcpy(new_ctx, ctx_bin.data, sizeof(SHA512_CTX)); - SHA512_Update(new_ctx, data_bin.data, data_bin.size); - CONSUME_REDS(env,data_bin); - return ret; -#else - return atom_notsup; +#ifdef HAVE_SHA384 + case NID_sha384: + ctx_size = sizeof(SHA512_CTX); + ctx_final = (final_fun)(&SHA384_Final); + break; #endif -} -static ERL_NIF_TERM sha512_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Context) */ #ifdef HAVE_SHA512 - ErlNifBinary ctx_bin; - SHA512_CTX ctx_clone; - ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != sizeof(SHA512_CTX)) { - return enif_make_badarg(env); - } - memcpy(&ctx_clone, ctx_bin.data, sizeof(SHA512_CTX)); /* writable */ - SHA512_Final(enif_make_new_binary(env, SHA512_LEN, &ret), &ctx_clone); - return ret; -#else - return atom_notsup; + case NID_sha512: + ctx_size = sizeof(SHA512_CTX); + ctx_final = (final_fun)(&SHA512_Final); + break; #endif -} - - -static ERL_NIF_TERM md4(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Data) */ - ErlNifBinary ibin; - ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - if (!enif_inspect_iolist_as_binary(env, argv[0], &ibin)) { - return enif_make_badarg(env); + default: + return atom_notsup; } - MD4((unsigned char *) ibin.data, ibin.size, - enif_make_new_binary(env,MD4_LEN, &ret)); - CONSUME_REDS(env,ibin); - return ret; -} -static ERL_NIF_TERM md4_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* () */ - ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - MD4_Init((MD4_CTX *) enif_make_new_binary(env, MD4_CTX_LEN, &ret)); - return ret; -} -static ERL_NIF_TERM md4_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Context, Data) */ - MD4_CTX* new_ctx; - ErlNifBinary ctx_bin, data_bin; - ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != MD4_CTX_LEN - || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) { - return enif_make_badarg(env); - } - new_ctx = (MD4_CTX*) enif_make_new_binary(env,MD4_CTX_LEN, &ret); - memcpy(new_ctx, ctx_bin.data, MD4_CTX_LEN); - MD4_Update(new_ctx, data_bin.data, data_bin.size); - CONSUME_REDS(env,data_bin); - return ret; -} -static ERL_NIF_TERM md4_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Context) */ - ErlNifBinary ctx_bin; - MD4_CTX ctx_clone; - ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != MD4_CTX_LEN) { - return enif_make_badarg(env); - } - memcpy(&ctx_clone, ctx_bin.data, MD4_CTX_LEN); /* writable */ - MD4_Final(enif_make_new_binary(env, MD4_LEN, &ret), &ctx_clone); - return ret; -} + ASSERT(ctx_size); + ASSERT(ctx_final); -static ERL_NIF_TERM md5_mac_n(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, Data, MacSize) */ - unsigned char hmacbuf[SHA_DIGEST_LENGTH]; - ErlNifBinary key, data; - unsigned mac_sz; - ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - if (!enif_inspect_iolist_as_binary(env, argv[0], &key) - || !enif_inspect_iolist_as_binary(env, argv[1], &data) - || !enif_get_uint(env,argv[2],&mac_sz) || mac_sz > MD5_LEN) { - return enif_make_badarg(env); + if (ctx.size != ctx_size) { + return enif_make_badarg(env); } - hmac_md5(key.data, key.size, data.data, data.size, hmacbuf); - memcpy(enif_make_new_binary(env, mac_sz, &ret), hmacbuf, mac_sz); - CONSUME_REDS(env,data); - return ret; -} -static ERL_NIF_TERM sha_mac_n(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, Data, MacSize) */ - unsigned char hmacbuf[SHA_DIGEST_LENGTH]; - ErlNifBinary key, data; - unsigned mac_sz; - ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - if (!enif_inspect_iolist_as_binary(env, argv[0], &key) - || !enif_inspect_iolist_as_binary(env, argv[1], &data) - || !enif_get_uint(env,argv[2],&mac_sz) || mac_sz > SHA_LEN) { - return enif_make_badarg(env); - } - hmac_sha1(key.data, key.size, data.data, data.size, hmacbuf); - memcpy(enif_make_new_binary(env, mac_sz, &ret), - hmacbuf, mac_sz); - CONSUME_REDS(env,data); - return ret; -} + new_ctx = enif_alloc(ctx_size); + memcpy(new_ctx, ctx.data, ctx_size); + ctx_final(enif_make_new_binary(env, (size_t)EVP_MD_size(md), &ret), + new_ctx); + enif_free(new_ctx); -static ERL_NIF_TERM sha224_mac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, Data, MacSize) */ -#ifdef HAVE_SHA224 - unsigned char hmacbuf[SHA224_DIGEST_LENGTH]; - ErlNifBinary key, data; - unsigned mac_sz; - ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - if (!enif_inspect_iolist_as_binary(env, argv[0], &key) - || !enif_inspect_iolist_as_binary(env, argv[1], &data) - || !enif_get_uint(env,argv[2],&mac_sz) || mac_sz > SHA224_DIGEST_LENGTH) { - return enif_make_badarg(env); - } - hmac_sha224(key.data, key.size, data.data, data.size, hmacbuf); - memcpy(enif_make_new_binary(env, mac_sz, &ret), - hmacbuf, mac_sz); - CONSUME_REDS(env,data); return ret; -#else - return atom_notsup; -#endif } +#endif /* OPENSSL_VERSION_NUMBER < 1.0 */ -static ERL_NIF_TERM sha256_mac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, Data, MacSize) */ -#ifdef HAVE_SHA256 - unsigned char hmacbuf[SHA256_DIGEST_LENGTH]; - ErlNifBinary key, data; - unsigned mac_sz; - ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - if (!enif_inspect_iolist_as_binary(env, argv[0], &key) - || !enif_inspect_iolist_as_binary(env, argv[1], &data) - || !enif_get_uint(env,argv[2],&mac_sz) || mac_sz > SHA256_DIGEST_LENGTH) { - return enif_make_badarg(env); - } - hmac_sha256(key.data, key.size, data.data, data.size, hmacbuf); - memcpy(enif_make_new_binary(env, mac_sz, &ret), - hmacbuf, mac_sz); - CONSUME_REDS(env,data); - return ret; -#else - return atom_notsup; -#endif -} +static ERL_NIF_TERM hmac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Type, Key, Data) or (Type, Key, Data, MacSize) */ + struct digest_type_t *digp = NULL; + ErlNifBinary key, data; + unsigned char buff[EVP_MAX_MD_SIZE]; + unsigned size = 0, req_size = 0; + ERL_NIF_TERM ret; -static ERL_NIF_TERM sha384_mac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, Data, MacSize) */ -#ifdef HAVE_SHA384 - unsigned char hmacbuf[SHA384_DIGEST_LENGTH]; - ErlNifBinary key, data; - unsigned mac_sz; - ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - if (!enif_inspect_iolist_as_binary(env, argv[0], &key) - || !enif_inspect_iolist_as_binary(env, argv[1], &data) - || !enif_get_uint(env,argv[2],&mac_sz) || mac_sz > SHA384_DIGEST_LENGTH) { - return enif_make_badarg(env); + digp = get_digest_type(argv[0]); + if (!digp || + !enif_inspect_iolist_as_binary(env, argv[1], &key) || + !enif_inspect_iolist_as_binary(env, argv[2], &data) || + (argc == 4 && !enif_get_uint(env, argv[3], &req_size))) { + return enif_make_badarg(env); } - hmac_sha384(key.data, key.size, data.data, data.size, hmacbuf); - memcpy(enif_make_new_binary(env, mac_sz, &ret), - hmacbuf, mac_sz); - CONSUME_REDS(env,data); - return ret; -#else - return atom_notsup; -#endif -} + if (!digp->md_func || + !HMAC(digp->md_func(), + key.data, key.size, + data.data, data.size, + buff, &size)) { + return atom_notsup; + } + ASSERT(0 < size && size <= EVP_MAX_MD_SIZE); + CONSUME_REDS(env, data); -static ERL_NIF_TERM sha512_mac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, Data, MacSize) */ -#ifdef HAVE_SHA512 - unsigned char hmacbuf[SHA512_DIGEST_LENGTH]; - ErlNifBinary key, data; - unsigned mac_sz; - ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - if (!enif_inspect_iolist_as_binary(env, argv[0], &key) - || !enif_inspect_iolist_as_binary(env, argv[1], &data) - || !enif_get_uint(env,argv[2],&mac_sz) || mac_sz > SHA512_DIGEST_LENGTH) { - return enif_make_badarg(env); + if (argc == 4) { + if (req_size <= size) { + size = req_size; + } + else { + return enif_make_badarg(env); + } } - hmac_sha512(key.data, key.size, data.data, data.size, hmacbuf); - memcpy(enif_make_new_binary(env, mac_sz, &ret), - hmacbuf, mac_sz); - CONSUME_REDS(env,data); + memcpy(enif_make_new_binary(env, size, &ret), buff, size); return ret; -#else - return atom_notsup; -#endif } static void hmac_context_dtor(ErlNifEnv* env, struct hmac_context *obj) @@ -1455,55 +1217,46 @@ static void hmac_context_dtor(ErlNifEnv* env, struct hmac_context *obj) enif_mutex_destroy(obj->mtx); } -static ERL_NIF_TERM hmac_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +static ERL_NIF_TERM hmac_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Type, Key) */ - ErlNifBinary key; - struct hmac_context* obj; - const EVP_MD *md; - ERL_NIF_TERM ret; - - CHECK_OSE_CRYPTO(); + struct digest_type_t *digp = NULL; + ErlNifBinary key; + ERL_NIF_TERM ret; + struct hmac_context *obj; - if (argv[0] == atom_sha) md = EVP_sha1(); -#ifdef HAVE_SHA224 - else if (argv[0] == atom_sha224) md = EVP_sha224(); -#endif -#ifdef HAVE_SHA256 - else if (argv[0] == atom_sha256) md = EVP_sha256(); -#endif -#ifdef HAVE_SHA384 - else if (argv[0] == atom_sha384) md = EVP_sha384(); -#endif -#ifdef HAVE_SHA512 - else if (argv[0] == atom_sha512) md = EVP_sha512(); -#endif - else if (argv[0] == atom_md5) md = EVP_md5(); - else if (argv[0] == atom_ripemd160) md = EVP_ripemd160(); - else goto badarg; - - if (!enif_inspect_iolist_as_binary(env, argv[1], &key)) { - badarg: - return enif_make_badarg(env); + digp = get_digest_type(argv[0]); + if (!digp || + !enif_inspect_iolist_as_binary(env, argv[1], &key)) { + return enif_make_badarg(env); + } + if (!digp->md_func) { + return atom_notsup; } obj = enif_alloc_resource(hmac_context_rtype, sizeof(struct hmac_context)); obj->mtx = enif_mutex_create("crypto.hmac"); obj->alive = 1; - HMAC_CTX_init(&obj->ctx); - HMAC_Init(&obj->ctx, key.data, key.size, md); +#if OPENSSL_VERSION_NUMBER >= 0x1000000fL + // Check the return value of HMAC_Init: it may fail in FIPS mode + // for disabled algorithms + if (!HMAC_Init(&obj->ctx, key.data, key.size, digp->md_func())) { + enif_release_resource(obj); + return atom_notsup; + } +#else + HMAC_Init(&obj->ctx, key.data, key.size, digp->md_func()); +#endif ret = enif_make_resource(env, obj); enif_release_resource(obj); return ret; } -static ERL_NIF_TERM hmac_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +static ERL_NIF_TERM hmac_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Context, Data) */ ErlNifBinary data; struct hmac_context* obj; - CHECK_OSE_CRYPTO(); - if (!enif_get_resource(env, argv[0], hmac_context_rtype, (void**)&obj) || !enif_inspect_iolist_as_binary(env, argv[1], &data)) { return enif_make_badarg(env); @@ -1520,7 +1273,7 @@ static ERL_NIF_TERM hmac_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg return argv[0]; } -static ERL_NIF_TERM hmac_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +static ERL_NIF_TERM hmac_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Context) or (Context, HashLen) */ ERL_NIF_TERM ret; struct hmac_context* obj; @@ -1529,8 +1282,6 @@ static ERL_NIF_TERM hmac_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv unsigned int req_len = 0; unsigned int mac_len; - CHECK_OSE_CRYPTO(); - if (!enif_get_resource(env,argv[0],hmac_context_rtype, (void**)&obj) || (argc == 2 && !enif_get_uint(env, argv[1], &req_len))) { return enif_make_badarg(env); @@ -1557,206 +1308,197 @@ static ERL_NIF_TERM hmac_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv return ret; } -static ERL_NIF_TERM des_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, Ivec, Text, IsEncrypt) */ - ErlNifBinary key, ivec, text; - DES_key_schedule schedule; - DES_cblock ivec_clone; /* writable copy */ - ERL_NIF_TERM ret; - - CHECK_OSE_CRYPTO(); +static ERL_NIF_TERM block_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Type, Key, Ivec, Text, IsEncrypt) or (Type, Key, Text, IsEncrypt) */ + struct cipher_type_t *cipherp = NULL; + const EVP_CIPHER *cipher; + ErlNifBinary key, ivec, text; + EVP_CIPHER_CTX ctx; + ERL_NIF_TERM ret; + unsigned char *out; + int ivec_size, out_size = 0; - if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || key.size != 8 - || !enif_inspect_binary(env, argv[1], &ivec) || ivec.size != 8 - || !enif_inspect_iolist_as_binary(env, argv[2], &text) - || text.size % 8 != 0) { - return enif_make_badarg(env); + if (!enif_inspect_iolist_as_binary(env, argv[1], &key) + || !(cipherp = get_cipher_type(argv[0], key.size)) + || !enif_inspect_iolist_as_binary(env, argv[argc - 2], &text)) { + return enif_make_badarg(env); } - memcpy(&ivec_clone, ivec.data, 8); - DES_set_key((const_DES_cblock*)key.data, &schedule); - DES_ncbc_encrypt(text.data, enif_make_new_binary(env, text.size, &ret), - text.size, &schedule, &ivec_clone, (argv[3] == atom_true)); - CONSUME_REDS(env,text); - return ret; -} - -static ERL_NIF_TERM des_cfb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, Ivec, Text, IsEncrypt) */ - ErlNifBinary key, ivec, text; - DES_key_schedule schedule; - DES_cblock ivec_clone; /* writable copy */ - ERL_NIF_TERM ret; - - CHECK_OSE_CRYPTO(); - - if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || key.size != 8 - || !enif_inspect_binary(env, argv[1], &ivec) || ivec.size != 8 - || !enif_inspect_iolist_as_binary(env, argv[2], &text)) { - return enif_make_badarg(env); + if (!cipherp->cipher_func) { + return enif_raise_exception(env, atom_notsup); } - memcpy(&ivec_clone, ivec.data, 8); - DES_set_key((const_DES_cblock*)key.data, &schedule); - DES_cfb_encrypt(text.data, enif_make_new_binary(env, text.size, &ret), - 8, text.size, &schedule, &ivec_clone, (argv[3] == atom_true)); - CONSUME_REDS(env,text); - return ret; -} -static ERL_NIF_TERM des_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, Text/Cipher, IsEncrypt) */ - ErlNifBinary key, text; - DES_key_schedule schedule; - ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || key.size != 8 || - !enif_inspect_iolist_as_binary(env, argv[1], &text) || text.size != 8) { - return enif_make_badarg(env); + if ((argv[0] == atom_aes_cfb8 || argv[0] == atom_aes_cfb128) + && (key.size == 24 || key.size == 32)) { + /* Why do EVP_CIPHER_CTX_set_key_length() fail on these key sizes? + * Fall back on low level API + */ + return aes_cfb_8_crypt(env, argc-1, argv+1); } - DES_set_key((const_DES_cblock*)key.data, &schedule); - DES_ecb_encrypt((const_DES_cblock*)text.data, - (DES_cblock*)enif_make_new_binary(env, 8, &ret), - &schedule, (argv[2] == atom_true)); - CONSUME_REDS(env,text); - return ret; -} -static ERL_NIF_TERM des_ede3_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key1, Key2, Key3, IVec, Text/Cipher, IsEncrypt) */ - ErlNifBinary key1, key2, key3, ivec, text; - DES_key_schedule schedule1, schedule2, schedule3; - DES_cblock ivec_clone; /* writable copy */ - ERL_NIF_TERM ret; + cipher = cipherp->cipher_func(); + ivec_size = EVP_CIPHER_iv_length(cipher); - CHECK_OSE_CRYPTO(); +#ifdef HAVE_ECB_IVEC_BUG + if (argv[0] == atom_aes_ecb || argv[0] == atom_blowfish_ecb || + argv[0] == atom_des_ecb) + ivec_size = 0; /* 0.9.8l returns faulty ivec_size */ +#endif - if (!enif_inspect_iolist_as_binary(env, argv[0], &key1) || key1.size != 8 - || !enif_inspect_iolist_as_binary(env, argv[1], &key2) || key2.size != 8 - || !enif_inspect_iolist_as_binary(env, argv[2], &key3) || key3.size != 8 - || !enif_inspect_binary(env, argv[3], &ivec) || ivec.size != 8 - || !enif_inspect_iolist_as_binary(env, argv[4], &text) - || text.size % 8 != 0) { - return enif_make_badarg(env); + if (text.size % EVP_CIPHER_block_size(cipher) != 0 || + (ivec_size == 0 ? argc != 4 + : (argc != 5 || + !enif_inspect_iolist_as_binary(env, argv[2], &ivec) || + ivec.size != ivec_size))) { + return enif_make_badarg(env); } - memcpy(&ivec_clone, ivec.data, 8); - DES_set_key((const_DES_cblock*)key1.data, &schedule1); - DES_set_key((const_DES_cblock*)key2.data, &schedule2); - DES_set_key((const_DES_cblock*)key3.data, &schedule3); - DES_ede3_cbc_encrypt(text.data, enif_make_new_binary(env,text.size,&ret), - text.size, &schedule1, &schedule2, &schedule3, - &ivec_clone, (argv[5] == atom_true)); - CONSUME_REDS(env,text); - return ret; -} + out = enif_make_new_binary(env, text.size, &ret); -static ERL_NIF_TERM des_ede3_cfb_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key1, Key2, Key3, IVec, Text/Cipher, IsEncrypt) */ -#ifdef HAVE_DES_ede3_cfb_encrypt - ErlNifBinary key1, key2, key3, ivec, text; - DES_key_schedule schedule1, schedule2, schedule3; - DES_cblock ivec_clone; /* writable copy */ - ERL_NIF_TERM ret; + EVP_CIPHER_CTX_init(&ctx); + if (!EVP_CipherInit_ex(&ctx, cipher, NULL, NULL, NULL, + (argv[argc - 1] == atom_true)) || + !EVP_CIPHER_CTX_set_key_length(&ctx, key.size) || + !(EVP_CIPHER_type(cipher) != NID_rc2_cbc || + EVP_CIPHER_CTX_ctrl(&ctx, EVP_CTRL_SET_RC2_KEY_BITS, key.size * 8, NULL)) || + !EVP_CipherInit_ex(&ctx, NULL, NULL, + key.data, ivec_size ? ivec.data : NULL, -1) || + !EVP_CIPHER_CTX_set_padding(&ctx, 0)) { - CHECK_OSE_CRYPTO(); + EVP_CIPHER_CTX_cleanup(&ctx); + return enif_raise_exception(env, atom_notsup); + } - if (!enif_inspect_iolist_as_binary(env, argv[0], &key1) || key1.size != 8 - || !enif_inspect_iolist_as_binary(env, argv[1], &key2) || key2.size != 8 - || !enif_inspect_iolist_as_binary(env, argv[2], &key3) || key3.size != 8 - || !enif_inspect_binary(env, argv[3], &ivec) || ivec.size != 8 - || !enif_inspect_iolist_as_binary(env, argv[4], &text)) { - return enif_make_badarg(env); + if (text.size > 0 && /* OpenSSL 0.9.8h asserts text.size > 0 */ + (!EVP_CipherUpdate(&ctx, out, &out_size, text.data, text.size) + || (ASSERT(out_size == text.size), 0) + || !EVP_CipherFinal_ex(&ctx, out + out_size, &out_size))) { + + EVP_CIPHER_CTX_cleanup(&ctx); + return enif_raise_exception(env, atom_notsup); } + ASSERT(out_size == 0); + EVP_CIPHER_CTX_cleanup(&ctx); + CONSUME_REDS(env, text); - memcpy(&ivec_clone, ivec.data, 8); - DES_set_key((const_DES_cblock*)key1.data, &schedule1); - DES_set_key((const_DES_cblock*)key2.data, &schedule2); - DES_set_key((const_DES_cblock*)key3.data, &schedule3); - DES_ede3_cfb_encrypt(text.data, enif_make_new_binary(env,text.size,&ret), - 8, text.size, &schedule1, &schedule2, &schedule3, - &ivec_clone, (argv[5] == atom_true)); - CONSUME_REDS(env,text); return ret; -#else - return atom_notsup; -#endif } static ERL_NIF_TERM aes_cfb_8_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, IVec, Data, IsEncrypt) */ - ErlNifBinary key, ivec, text; - AES_KEY aes_key; - unsigned char ivec_clone[16]; /* writable copy */ - int new_ivlen = 0; - ERL_NIF_TERM ret; - - if (!enif_inspect_iolist_as_binary(env, argv[0], &key) - || !(key.size == 16 || key.size == 24 || key.size == 32) - || !enif_inspect_binary(env, argv[1], &ivec) || ivec.size != 16 - || !enif_inspect_iolist_as_binary(env, argv[2], &text)) { - return enif_make_badarg(env); - } - - memcpy(ivec_clone, ivec.data, 16); - AES_set_encrypt_key(key.data, key.size * 8, &aes_key); - AES_cfb8_encrypt((unsigned char *) text.data, - enif_make_new_binary(env, text.size, &ret), - text.size, &aes_key, ivec_clone, &new_ivlen, - (argv[3] == atom_true)); - CONSUME_REDS(env,text); - return ret; +{/* (Key, IVec, Data, IsEncrypt) */ + ErlNifBinary key, ivec, text; + AES_KEY aes_key; + unsigned char ivec_clone[16]; /* writable copy */ + int new_ivlen = 0; + ERL_NIF_TERM ret; + + if (!enif_inspect_iolist_as_binary(env, argv[0], &key) + || !(key.size == 16 || key.size == 24 || key.size == 32) + || !enif_inspect_binary(env, argv[1], &ivec) || ivec.size != 16 + || !enif_inspect_iolist_as_binary(env, argv[2], &text)) { + return enif_make_badarg(env); + } + + memcpy(ivec_clone, ivec.data, 16); + AES_set_encrypt_key(key.data, key.size * 8, &aes_key); + AES_cfb8_encrypt((unsigned char *) text.data, + enif_make_new_binary(env, text.size, &ret), + text.size, &aes_key, ivec_clone, &new_ivlen, + (argv[3] == atom_true)); + CONSUME_REDS(env,text); + return ret; } -static ERL_NIF_TERM aes_cfb_128_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, IVec, Data, IsEncrypt) */ - ErlNifBinary key, ivec, text; +static ERL_NIF_TERM aes_ige_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Key, IVec, Data, IsEncrypt) */ +#ifdef HAVE_AES_IGE + ErlNifBinary key_bin, ivec_bin, data_bin; AES_KEY aes_key; - unsigned char ivec_clone[16]; /* writable copy */ - int new_ivlen = 0; + unsigned char ivec[32]; + int i; + unsigned char* ret_ptr; ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); + if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin) + || (key_bin.size != 16 && key_bin.size != 32) + || !enif_inspect_binary(env, argv[1], &ivec_bin) + || ivec_bin.size != 32 + || !enif_inspect_iolist_as_binary(env, argv[2], &data_bin) + || data_bin.size % 16 != 0) { - if (!enif_inspect_iolist_as_binary(env, argv[0], &key) - || !(key.size == 16 || key.size == 24 || key.size == 32) - || !enif_inspect_binary(env, argv[1], &ivec) || ivec.size != 16 - || !enif_inspect_iolist_as_binary(env, argv[2], &text)) { - return enif_make_badarg(env); + return enif_make_badarg(env); } - memcpy(ivec_clone, ivec.data, 16); - AES_set_encrypt_key(key.data, key.size * 8, &aes_key); - AES_cfb128_encrypt((unsigned char *) text.data, - enif_make_new_binary(env, text.size, &ret), - text.size, &aes_key, ivec_clone, &new_ivlen, - (argv[3] == atom_true)); - CONSUME_REDS(env,text); + if (argv[3] == atom_true) { + i = AES_ENCRYPT; + AES_set_encrypt_key(key_bin.data, key_bin.size*8, &aes_key); + } + else { + i = AES_DECRYPT; + AES_set_decrypt_key(key_bin.data, key_bin.size*8, &aes_key); + } + + ret_ptr = enif_make_new_binary(env, data_bin.size, &ret); + memcpy(ivec, ivec_bin.data, 32); /* writable copy */ + AES_ige_encrypt(data_bin.data, ret_ptr, data_bin.size, &aes_key, ivec, i); + CONSUME_REDS(env,data_bin); return ret; +#else + return atom_notsup; +#endif } /* Common for both encrypt and decrypt */ static ERL_NIF_TERM aes_ctr_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Key, IVec, Data) */ - ErlNifBinary key, ivec, text; - AES_KEY aes_key; - unsigned char ivec_clone[16]; /* writable copy */ - unsigned char ecount_buf[AES_BLOCK_SIZE]; - unsigned int num = 0; - ERL_NIF_TERM ret; - - CHECK_OSE_CRYPTO(); + ErlNifBinary key, ivec, text; +#ifdef HAVE_EVP_AES_CTR + const EVP_CIPHER *cipher; + EVP_CIPHER_CTX ctx; + unsigned char *out; + int outl = 0; +#else + AES_KEY aes_key; + unsigned char ivec_clone[16]; /* writable copy */ + unsigned char ecount_buf[AES_BLOCK_SIZE]; + unsigned int num = 0; +#endif + ERL_NIF_TERM ret; if (!enif_inspect_iolist_as_binary(env, argv[0], &key) +#ifndef HAVE_EVP_AES_CTR || AES_set_encrypt_key(key.data, key.size*8, &aes_key) != 0 +#endif || !enif_inspect_binary(env, argv[1], &ivec) || ivec.size != 16 || !enif_inspect_iolist_as_binary(env, argv[2], &text)) { return enif_make_badarg(env); } +#ifdef HAVE_EVP_AES_CTR + switch (key.size) + { + case 16: cipher = EVP_aes_128_ctr(); break; + case 24: cipher = EVP_aes_192_ctr(); break; + case 32: cipher = EVP_aes_256_ctr(); break; + default: return enif_make_badarg(env); + } + + out = enif_make_new_binary(env,text.size,&ret); + EVP_CIPHER_CTX_init(&ctx); + EVP_CipherInit_ex(&ctx, cipher, NULL, + key.data, ivec.data, (argv[3] == atom_true)); + EVP_CIPHER_CTX_set_padding(&ctx, 0); + EVP_CipherUpdate(&ctx, out, &outl, text.data, text.size); + ASSERT(outl == text.size); + EVP_CipherFinal_ex(&ctx, out + outl, &outl); + ASSERT(outl == 0); + EVP_CIPHER_CTX_cleanup(&ctx); +#else memcpy(ivec_clone, ivec.data, 16); memset(ecount_buf, 0, sizeof(ecount_buf)); AES_ctr128_encrypt((unsigned char *) text.data, enif_make_new_binary(env, text.size, &ret), text.size, &aes_key, ivec_clone, ecount_buf, &num); +#endif CONSUME_REDS(env,text); /* To do an incremental {en|de}cryption, the state to to keep between calls @@ -1766,6 +1508,81 @@ static ERL_NIF_TERM aes_ctr_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM /* Initializes state for ctr streaming (de)encryption */ +#ifdef HAVE_EVP_AES_CTR +static ERL_NIF_TERM aes_ctr_stream_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Key, IVec) */ + ErlNifBinary key_bin, ivec_bin; + EVP_CIPHER_CTX *ctx; + const EVP_CIPHER *cipher; + ERL_NIF_TERM ret; + + if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin) + || !enif_inspect_binary(env, argv[1], &ivec_bin) + || ivec_bin.size != 16) { + return enif_make_badarg(env); + } + + switch (key_bin.size) + { + case 16: cipher = EVP_aes_128_ctr(); break; + case 24: cipher = EVP_aes_192_ctr(); break; + case 32: cipher = EVP_aes_256_ctr(); break; + default: return enif_make_badarg(env); + } + + ctx = enif_alloc_resource(evp_cipher_ctx_rtype, sizeof(EVP_CIPHER_CTX)); + EVP_CIPHER_CTX_init(ctx); + EVP_CipherInit_ex(ctx, cipher, NULL, + key_bin.data, ivec_bin.data, 1); + EVP_CIPHER_CTX_set_padding(ctx, 0); + ret = enif_make_resource(env, ctx); + enif_release_resource(ctx); + return ret; +} +static ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Context, Data) */ + EVP_CIPHER_CTX *ctx, *new_ctx; + ErlNifBinary data_bin; + ERL_NIF_TERM ret, cipher_term; + unsigned char *out; + int outl = 0; + + if (!enif_get_resource(env, argv[0], evp_cipher_ctx_rtype, (void**)&ctx) + || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) { + return enif_make_badarg(env); + } + new_ctx = enif_alloc_resource(evp_cipher_ctx_rtype, sizeof(EVP_CIPHER_CTX)); + EVP_CIPHER_CTX_init(new_ctx); + EVP_CIPHER_CTX_copy(new_ctx, ctx); + out = enif_make_new_binary(env, data_bin.size, &cipher_term); + EVP_CipherUpdate(new_ctx, out, &outl, data_bin.data, data_bin.size); + ASSERT(outl == data_bin.size); + + ret = enif_make_tuple2(env, enif_make_resource(env, new_ctx), cipher_term); + enif_release_resource(new_ctx); + CONSUME_REDS(env,data_bin); + return ret; +} + +#else /* if not HAVE_EVP_AES_CTR */ + +static ERL_NIF_TERM aes_ctr_stream_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Key, IVec) */ + ErlNifBinary key_bin, ivec_bin; + ERL_NIF_TERM ecount_bin; + + if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin) + || !enif_inspect_binary(env, argv[1], &ivec_bin) + || !(key_bin.size == 16 || key_bin.size == 24 || key_bin.size ==32) + || ivec_bin.size != 16) { + return enif_make_badarg(env); + } + + memset(enif_make_new_binary(env, AES_BLOCK_SIZE, &ecount_bin), + 0, AES_BLOCK_SIZE); + return enif_make_tuple4(env, argv[0], argv[1], ecount_bin, enif_make_int(env, 0)); +} + static ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* ({Key, IVec, ECount, Num}, Data) */ ErlNifBinary key_bin, ivec_bin, text_bin, ecount_bin; @@ -1777,8 +1594,6 @@ static ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_N unsigned char * ivec2_buf; unsigned char * ecount2_buf; - CHECK_OSE_CRYPTO(); - if (!enif_get_tuple(env, argv[0], &state_arity, &state_term) || state_arity != 4 || !enif_inspect_iolist_as_binary(env, state_term[0], &key_bin) @@ -1806,70 +1621,86 @@ static ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_N CONSUME_REDS(env,text_bin); return ret; } +#endif /* !HAVE_EVP_AES_CTR */ static ERL_NIF_TERM aes_gcm_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Key,Iv,AAD,In) */ #if defined(HAVE_GCM) - GCM128_CONTEXT *ctx = NULL; + EVP_CIPHER_CTX ctx; + const EVP_CIPHER *cipher = NULL; ErlNifBinary key, iv, aad, in; - AES_KEY aes_key; - unsigned char *outp; + unsigned char *outp, *tagp; ERL_NIF_TERM out, out_tag; - - CHECK_OSE_CRYPTO(); + int len; if (!enif_inspect_iolist_as_binary(env, argv[0], &key) - || AES_set_encrypt_key(key.data, key.size*8, &aes_key) != 0 + || (key.size != 16 && key.size != 24 && key.size != 32) || !enif_inspect_binary(env, argv[1], &iv) || iv.size == 0 || !enif_inspect_iolist_as_binary(env, argv[2], &aad) || !enif_inspect_iolist_as_binary(env, argv[3], &in)) { return enif_make_badarg(env); } - if (!(ctx = CRYPTO_gcm128_new(&aes_key, (block128_f)AES_encrypt))) - return atom_error; + if (key.size == 16) + cipher = EVP_aes_128_gcm(); + else if (key.size == 24) + cipher = EVP_aes_192_gcm(); + else if (key.size == 32) + cipher = EVP_aes_256_gcm(); - CRYPTO_gcm128_setiv(ctx, iv.data, iv.size); + EVP_CIPHER_CTX_init(&ctx); - if (CRYPTO_gcm128_aad(ctx, aad.data, aad.size)) - goto out_err; + if (EVP_EncryptInit_ex(&ctx, cipher, NULL, NULL, NULL) != 1) + goto out_err; + + EVP_CIPHER_CTX_set_padding(&ctx, 0); + + if (EVP_CIPHER_CTX_ctrl(&ctx, EVP_CTRL_GCM_SET_IVLEN, iv.size, NULL) != 1) + goto out_err; + if (EVP_EncryptInit_ex(&ctx, NULL, NULL, key.data, iv.data) != 1) + goto out_err; + if (EVP_EncryptUpdate(&ctx, NULL, &len, aad.data, aad.size) != 1) + goto out_err; outp = enif_make_new_binary(env, in.size, &out); - /* encrypt */ - if (CRYPTO_gcm128_encrypt(ctx, in.data, outp, in.size)) - goto out_err; + if (EVP_EncryptUpdate(&ctx, outp, &len, in.data, in.size) != 1) + goto out_err; + if (EVP_EncryptFinal_ex(&ctx, outp+len, &len) != 1) + goto out_err; + + tagp = enif_make_new_binary(env, EVP_GCM_TLS_TAG_LEN, &out_tag); - /* calculate the tag */ - CRYPTO_gcm128_tag(ctx, enif_make_new_binary(env, EVP_GCM_TLS_TAG_LEN, &out_tag), EVP_GCM_TLS_TAG_LEN); - CRYPTO_gcm128_release(ctx); + if (EVP_CIPHER_CTX_ctrl(&ctx, EVP_CTRL_GCM_GET_TAG, EVP_GCM_TLS_TAG_LEN, tagp) != 1) + goto out_err; + + EVP_CIPHER_CTX_cleanup(&ctx); CONSUME_REDS(env, in); return enif_make_tuple2(env, out, out_tag); out_err: - CRYPTO_gcm128_release(ctx); + EVP_CIPHER_CTX_cleanup(&ctx); return atom_error; #else - return atom_notsup; + return enif_raise_exception(env, atom_notsup); #endif } static ERL_NIF_TERM aes_gcm_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Key,Iv,AAD,In,Tag) */ #if defined(HAVE_GCM) - GCM128_CONTEXT *ctx; + EVP_CIPHER_CTX ctx; + const EVP_CIPHER *cipher = NULL; ErlNifBinary key, iv, aad, in, tag; - AES_KEY aes_key; unsigned char *outp; ERL_NIF_TERM out; - - CHECK_OSE_CRYPTO(); + int len; if (!enif_inspect_iolist_as_binary(env, argv[0], &key) - || AES_set_encrypt_key(key.data, key.size*8, &aes_key) != 0 + || (key.size != 16 && key.size != 24 && key.size != 32) || !enif_inspect_binary(env, argv[1], &iv) || iv.size == 0 || !enif_inspect_iolist_as_binary(env, argv[2], &aad) || !enif_inspect_iolist_as_binary(env, argv[3], &in) @@ -1877,34 +1708,45 @@ static ERL_NIF_TERM aes_gcm_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM return enif_make_badarg(env); } - if (!(ctx = CRYPTO_gcm128_new(&aes_key, (block128_f)AES_encrypt))) - return atom_error; + if (key.size == 16) + cipher = EVP_aes_128_gcm(); + else if (key.size == 24) + cipher = EVP_aes_192_gcm(); + else if (key.size == 32) + cipher = EVP_aes_256_gcm(); - CRYPTO_gcm128_setiv(ctx, iv.data, iv.size); + EVP_CIPHER_CTX_init(&ctx); - if (CRYPTO_gcm128_aad(ctx, aad.data, aad.size)) - goto out_err; + if (EVP_DecryptInit_ex(&ctx, cipher, NULL, NULL, NULL) != 1) + goto out_err; + if (EVP_CIPHER_CTX_ctrl(&ctx, EVP_CTRL_GCM_SET_IVLEN, iv.size, NULL) != 1) + goto out_err; + if (EVP_DecryptInit_ex(&ctx, NULL, NULL, key.data, iv.data) != 1) + goto out_err; + if (EVP_DecryptUpdate(&ctx, NULL, &len, aad.data, aad.size) != 1) + goto out_err; outp = enif_make_new_binary(env, in.size, &out); - /* decrypt */ - if (CRYPTO_gcm128_decrypt(ctx, in.data, outp, in.size)) - goto out_err; + if (EVP_DecryptUpdate(&ctx, outp, &len, in.data, in.size) != 1) + goto out_err; + if (EVP_CIPHER_CTX_ctrl(&ctx, EVP_CTRL_GCM_SET_TAG, EVP_GCM_TLS_TAG_LEN, tag.data) != 1) + goto out_err; + if (EVP_DecryptFinal_ex(&ctx, outp+len, &len) != 1) + goto out_err; - /* calculate and check the tag */ - if (CRYPTO_gcm128_finish(ctx, tag.data, EVP_GCM_TLS_TAG_LEN)) - goto out_err; + EVP_CIPHER_CTX_cleanup(&ctx); - CRYPTO_gcm128_release(ctx); CONSUME_REDS(env, in); return out; out_err: - CRYPTO_gcm128_release(ctx); + EVP_CIPHER_CTX_cleanup(&ctx); return atom_error; + #else - return atom_notsup; + return enif_raise_exception(env, atom_notsup); #endif } @@ -1937,8 +1779,6 @@ static ERL_NIF_TERM chacha20_poly1305_encrypt(ErlNifEnv* env, int argc, const ER unsigned char poly1305_key[32]; poly1305_state poly1305; - CHECK_OSE_CRYPTO(); - if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || key.size != 32 || !enif_inspect_binary(env, argv[1], &iv) || iv.size != CHACHA20_NONCE_LEN || !enif_inspect_iolist_as_binary(env, argv[2], &aad) @@ -1976,7 +1816,7 @@ static ERL_NIF_TERM chacha20_poly1305_encrypt(ErlNifEnv* env, int argc, const ER return enif_make_tuple2(env, out, out_tag); #else - return atom_notsup; + return enif_raise_exception(env, atom_notsup); #endif } @@ -1991,8 +1831,6 @@ static ERL_NIF_TERM chacha20_poly1305_decrypt(ErlNifEnv* env, int argc, const ER unsigned char mac[POLY1305_TAG_LEN]; poly1305_state poly1305; - CHECK_OSE_CRYPTO(); - if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || key.size != 32 || !enif_inspect_binary(env, argv[1], &iv) || iv.size != CHACHA20_NONCE_LEN || !enif_inspect_iolist_as_binary(env, argv[2], &aad) @@ -2033,48 +1871,16 @@ static ERL_NIF_TERM chacha20_poly1305_decrypt(ErlNifEnv* env, int argc, const ER return out; #else - return atom_notsup; + return enif_raise_exception(env, atom_notsup); #endif } -static ERL_NIF_TERM aes_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, Data, IsEncrypt) */ - ErlNifBinary key_bin, data_bin; - AES_KEY aes_key; - int i; - unsigned char* ret_ptr; - ERL_NIF_TERM ret; - - CHECK_OSE_CRYPTO(); - - if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin) - || (key_bin.size != 16 && key_bin.size != 32) - || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin) - || data_bin.size % 16 != 0) { - return enif_make_badarg(env); - } - - if (argv[2] == atom_true) { - i = AES_ENCRYPT; - AES_set_encrypt_key(key_bin.data, key_bin.size*8, &aes_key); - } - else { - i = AES_DECRYPT; - AES_set_decrypt_key(key_bin.data, key_bin.size*8, &aes_key); - } - - ret_ptr = enif_make_new_binary(env, data_bin.size, &ret); - AES_ecb_encrypt(data_bin.data, ret_ptr, &aes_key, i); - CONSUME_REDS(env,data_bin); - return ret; -} - static ERL_NIF_TERM rand_bytes_1(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Bytes) */ unsigned bytes; unsigned char* data; ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); + if (!enif_get_uint(env, argv[0], &bytes)) { return enif_make_badarg(env); } @@ -2088,7 +1894,7 @@ static ERL_NIF_TERM strong_rand_bytes_nif(ErlNifEnv* env, int argc, const ERL_NI unsigned bytes; unsigned char* data; ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); + if (!enif_get_uint(env, argv[0], &bytes)) { return enif_make_badarg(env); } @@ -2106,7 +1912,7 @@ static ERL_NIF_TERM rand_bytes_3(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar unsigned char* data; unsigned top_mask, bot_mask; ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); + if (!enif_get_uint(env, argv[0], &bytes) || !enif_get_uint(env, argv[1], &top_mask) || !enif_get_uint(env, argv[2], &bot_mask)) { @@ -2130,8 +1936,6 @@ static ERL_NIF_TERM strong_rand_mpint_nif(ErlNifEnv* env, int argc, const ERL_NI unsigned dlen; ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - if (!enif_get_uint(env, argv[0], &bits) || !enif_get_int(env, argv[1], &top) || !enif_get_int(env, argv[2], &bottom)) { @@ -2200,8 +2004,6 @@ static ERL_NIF_TERM rand_uniform_nif(ErlNifEnv* env, int argc, const ERL_NIF_TER unsigned dlen; ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - if (!get_bn_from_mpint(env, argv[0], &bn_from) || !get_bn_from_mpint(env, argv[1], &bn_rand)) { if (bn_from) BN_free(bn_from); @@ -2233,8 +2035,6 @@ static ERL_NIF_TERM mod_exp_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg unsigned extra_byte; ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - if (!get_bn_from_bin(env, argv[0], &bn_base) || !get_bn_from_bin(env, argv[1], &bn_exponent) || !get_bn_from_bin(env, argv[2], &bn_modulo) @@ -2266,46 +2066,17 @@ static ERL_NIF_TERM mod_exp_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg } static ERL_NIF_TERM dss_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (DigestType|none, Data|{digest,Digest}, Signature,Key=[P, Q, G, Y]) */ - ErlNifBinary data_bin, sign_bin; +{/* (sha, Digest, Signature,Key=[P, Q, G, Y]) */ + ErlNifBinary digest_bin, sign_bin; BIGNUM *dsa_p = NULL, *dsa_q = NULL, *dsa_g = NULL, *dsa_y = NULL; - unsigned char hmacbuf[SHA_DIGEST_LENGTH]; - unsigned char* digest; ERL_NIF_TERM head, tail; - const ERL_NIF_TERM* tpl_terms; - int tpl_arity; DSA *dsa; int i; - CHECK_OSE_CRYPTO(); - - if (argv[0] == atom_sha) { - if (enif_get_tuple(env, argv[1], &tpl_arity, &tpl_terms)) { - if (tpl_arity != 2 || tpl_terms[0] != atom_digest - || !enif_inspect_binary(env, tpl_terms[1], &data_bin) - || data_bin.size != SHA_DIGEST_LENGTH) { - - return enif_make_badarg(env); - } - digest = data_bin.data; - } - else { - if (!enif_inspect_binary(env, argv[1], &data_bin)) { - return enif_make_badarg(env); - } - SHA1(data_bin.data, data_bin.size, hmacbuf); - digest = hmacbuf; - } - } - else if (argv[0] == atom_none && enif_inspect_binary(env, argv[1], &data_bin) - && data_bin.size == SHA_DIGEST_LENGTH) { - digest = data_bin.data; - } - else { - return enif_make_badarg(env); - } - - if (!enif_inspect_binary(env, argv[2], &sign_bin) + if (!argv[0] == atom_sha + || !enif_inspect_binary(env, argv[1], &digest_bin) + || digest_bin.size != SHA_DIGEST_LENGTH + || !enif_inspect_binary(env, argv[2], &sign_bin) || !enif_get_list_cell(env, argv[3], &head, &tail) || !get_bn_from_bin(env, head, &dsa_p) || !enif_get_list_cell(env, tail, &head, &tail) @@ -2329,94 +2100,27 @@ static ERL_NIF_TERM dss_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM dsa->g = dsa_g; dsa->priv_key = NULL; dsa->pub_key = dsa_y; - i = DSA_verify(0, digest, SHA_DIGEST_LENGTH, + i = DSA_verify(0, digest_bin.data, SHA_DIGEST_LENGTH, sign_bin.data, sign_bin.size, dsa); DSA_free(dsa); return(i > 0) ? atom_true : atom_false; } - -static void md5_digest(unsigned char* in, unsigned int in_len, unsigned char* out) -{ - MD5(in, in_len, out); -} -static void sha1_digest(unsigned char* in, unsigned int in_len, unsigned char* out) -{ - SHA1(in, in_len, out); -} -#ifdef HAVE_SHA224 -static void sha224_digest(unsigned char* in, unsigned int in_len, unsigned char* out) -{ - SHA224(in, in_len, out); -} -#endif -#ifdef HAVE_SHA256 -static void sha256_digest(unsigned char* in, unsigned int in_len, unsigned char* out) -{ - SHA256(in, in_len, out); -} -#endif -#ifdef HAVE_SHA384 -static void sha384_digest(unsigned char* in, unsigned int in_len, unsigned char* out) -{ - SHA384(in, in_len, out); -} -#endif -#ifdef HAVE_SHA512 -static void sha512_digest(unsigned char* in, unsigned int in_len, unsigned char* out) +static void init_digest_types(ErlNifEnv* env) { - SHA512(in, in_len, out); -} -#endif + struct digest_type_t* p = digest_types; -struct digest_type_t { - const char* type_str; - unsigned len; /* 0 if notsup */ - int NID_type; - void (*funcp)(unsigned char* in, unsigned int in_len, unsigned char* out); - ERL_NIF_TERM type_atom; -}; + for (p = digest_types; p->type_str; p++) { + p->type_atom = enif_make_atom(env, p->type_str); + } -struct digest_type_t digest_types[] = -{ - {"md5", MD5_DIGEST_LENGTH, NID_md5, md5_digest}, - {"sha", SHA_DIGEST_LENGTH, NID_sha1, sha1_digest}, - {"sha224", -#ifdef HAVE_SHA224 - SHA224_LEN, NID_sha224, sha224_digest -#else - 0 -#endif - }, - {"sha256", -#ifdef HAVE_SHA256 - SHA256_LEN, NID_sha256, sha256_digest -#else - 0 -#endif - }, - {"sha384", -#ifdef HAVE_SHA384 - SHA384_LEN, NID_sha384, sha384_digest -#else - 0 -#endif - }, - {"sha512", -#ifdef HAVE_SHA512 - SHA512_LEN, NID_sha512, sha512_digest -#else - 0 -#endif - }, - {NULL} -}; +} -static void init_digest_types(ErlNifEnv* env) +static void init_cipher_types(ErlNifEnv* env) { - struct digest_type_t* p = digest_types; + struct cipher_type_t* p = cipher_types; - for (p = digest_types; p->type_str; p++) { + for (p = cipher_types; p->type_str; p++) { p->type_atom = enif_make_atom(env, p->type_str); } @@ -2433,32 +2137,45 @@ static struct digest_type_t* get_digest_type(ERL_NIF_TERM type) return NULL; } -static ERL_NIF_TERM rsa_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Type, Data|{digest,Digest}, Signature, Key=[E,N]) */ - ErlNifBinary data_bin, sign_bin; - unsigned char hmacbuf[SHA512_LEN]; - ERL_NIF_TERM head, tail, ret; - int i; - RSA* rsa; - const ERL_NIF_TERM type = argv[0]; - const ERL_NIF_TERM* tpl_terms; - int tpl_arity; - struct digest_type_t* digp = NULL; - unsigned char* digest = NULL; +static struct cipher_type_t* get_cipher_type(ERL_NIF_TERM type, size_t key_len) +{ + struct cipher_type_t* p = NULL; + for (p = cipher_types; p->type_str; p++) { + if (type == p->type_atom && (!p->key_len || key_len == p->key_len)) { + return p; + } + } + return NULL; +} - CHECK_OSE_CRYPTO(); +static ERL_NIF_TERM rsa_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Type, Digest, Signature, Key=[E,N]) */ + ErlNifBinary digest_bin, sign_bin; + ERL_NIF_TERM head, tail, ret; + int i; + RSA *rsa; +#if OPENSSL_VERSION_NUMBER >= 0x1000000fL + EVP_PKEY *pkey; + EVP_PKEY_CTX *ctx; +#endif + const EVP_MD *md; + const ERL_NIF_TERM type = argv[0]; + struct digest_type_t *digp = NULL; digp = get_digest_type(type); if (!digp) { return enif_make_badarg(env); } - if (!digp->len) { + if (!digp->md_func) { return atom_notsup; } rsa = RSA_new(); + md = digp->md_func(); - if (!enif_inspect_binary(env, argv[2], &sign_bin) + if (!enif_inspect_binary(env, argv[1], &digest_bin) + || digest_bin.size != EVP_MD_size(md) + || !enif_inspect_binary(env, argv[2], &sign_bin) || !enif_get_list_cell(env, argv[3], &head, &tail) || !get_bn_from_bin(env, head, &rsa->e) || !enif_get_list_cell(env, tail, &head, &tail) @@ -2468,27 +2185,24 @@ static ERL_NIF_TERM rsa_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ret = enif_make_badarg(env); goto done; } - if (enif_get_tuple(env, argv[1], &tpl_arity, &tpl_terms)) { - if (tpl_arity != 2 || tpl_terms[0] != atom_digest - || !enif_inspect_binary(env, tpl_terms[1], &data_bin) - || data_bin.size != digp->len) { - ret = enif_make_badarg(env); - goto done; - } - digest = data_bin.data; - } - else if (enif_inspect_binary(env, argv[1], &data_bin)) { - digest = hmacbuf; - digp->funcp(data_bin.data, data_bin.size, digest); - } - else { - ret = enif_make_badarg(env); - goto done; - } - - i = RSA_verify(digp->NID_type, digest, digp->len, +#if OPENSSL_VERSION_NUMBER >= 0x1000000fL + pkey = EVP_PKEY_new(); + EVP_PKEY_set1_RSA(pkey, rsa); + + ctx = EVP_PKEY_CTX_new(pkey, NULL); + EVP_PKEY_verify_init(ctx); + EVP_PKEY_CTX_set_rsa_padding(ctx, RSA_PKCS1_PADDING); + EVP_PKEY_CTX_set_signature_md(ctx, md); + + i = EVP_PKEY_verify(ctx, sign_bin.data, sign_bin.size, + digest_bin.data, digest_bin.size); + EVP_PKEY_CTX_free(ctx); + EVP_PKEY_free(pkey); +#else + i = RSA_verify(md->type, digest_bin.data, EVP_MD_size(md), sign_bin.data, sign_bin.size, rsa); +#endif ret = (i==1 ? atom_true : atom_false); @@ -2497,109 +2211,6 @@ done: return ret; } - -static ERL_NIF_TERM aes_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, IVec, Data, IsEncrypt) */ - ErlNifBinary key_bin, ivec_bin, data_bin; - unsigned char ivec[16]; - int enc, i = 0, outlen = 0; - EVP_CIPHER_CTX ctx; - const EVP_CIPHER *cipher = NULL; - unsigned char* ret_ptr; - ERL_NIF_TERM ret; - - CHECK_OSE_CRYPTO(); - - if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin) - || (key_bin.size != 16 && key_bin.size != 32) - || !enif_inspect_binary(env, argv[1], &ivec_bin) - || ivec_bin.size != 16 - || !enif_inspect_iolist_as_binary(env, argv[2], &data_bin) - || data_bin.size % 16 != 0) { - - return enif_make_badarg(env); - } - - if (argv[3] == atom_true) - enc = 1; - else - enc = 0; - - EVP_CIPHER_CTX_init(&ctx); - - if (key_bin.size == 16) - cipher = EVP_aes_128_cbc(); - else if (key_bin.size == 32) - cipher = EVP_aes_256_cbc(); - - memcpy(ivec, ivec_bin.data, 16); /* writeable copy */ - - /* openssl docs say we need to leave at least 3 blocks available - at the end of the buffer for EVP calls. let's be safe */ - ret_ptr = enif_make_new_binary(env, data_bin.size + 16*3, &ret); - - if (EVP_CipherInit_ex(&ctx, cipher, NULL, key_bin.data, ivec, enc) != 1) - return enif_make_badarg(env); - - /* disable padding, we only handle whole blocks */ - EVP_CIPHER_CTX_set_padding(&ctx, 0); - - if (EVP_CipherUpdate(&ctx, ret_ptr, &i, data_bin.data, data_bin.size) != 1) - return enif_make_badarg(env); - outlen += i; - if (EVP_CipherFinal_ex(&ctx, ret_ptr + outlen, &i) != 1) - return enif_make_badarg(env); - outlen += i; - - EVP_CIPHER_CTX_cleanup(&ctx); - - CONSUME_REDS(env,data_bin); - - /* the garbage collector is going to love this */ - return enif_make_sub_binary(env, ret, 0, outlen); -} - -static ERL_NIF_TERM aes_ige_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, IVec, Data, IsEncrypt) */ -#ifdef HAVE_AES_IGE - ErlNifBinary key_bin, ivec_bin, data_bin; - AES_KEY aes_key; - unsigned char ivec[32]; - int i; - unsigned char* ret_ptr; - ERL_NIF_TERM ret; - - CHECK_OSE_CRYPTO(); - - if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin) - || (key_bin.size != 16 && key_bin.size != 32) - || !enif_inspect_binary(env, argv[1], &ivec_bin) - || ivec_bin.size != 32 - || !enif_inspect_iolist_as_binary(env, argv[2], &data_bin) - || data_bin.size % 16 != 0) { - - return enif_make_badarg(env); - } - - if (argv[3] == atom_true) { - i = AES_ENCRYPT; - AES_set_encrypt_key(key_bin.data, key_bin.size*8, &aes_key); - } - else { - i = AES_DECRYPT; - AES_set_decrypt_key(key_bin.data, key_bin.size*8, &aes_key); - } - - ret_ptr = enif_make_new_binary(env, data_bin.size, &ret); - memcpy(ivec, ivec_bin.data, 32); /* writable copy */ - AES_ige_encrypt(data_bin.data, ret_ptr, data_bin.size, &aes_key, ivec, i); - CONSUME_REDS(env,data_bin); - return ret; -#else - return atom_notsup; -#endif -} - static ERL_NIF_TERM do_exor(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Data1, Data2) */ ErlNifBinary d1, d2; @@ -2607,8 +2218,6 @@ static ERL_NIF_TERM do_exor(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) int i; ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - if (!enif_inspect_iolist_as_binary(env,argv[0], &d1) || !enif_inspect_iolist_as_binary(env,argv[1], &d2) || d1.size != d2.size) { @@ -2629,8 +2238,6 @@ static ERL_NIF_TERM rc4_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg RC4_KEY rc4_key; ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - if (!enif_inspect_iolist_as_binary(env,argv[0], &key) || !enif_inspect_iolist_as_binary(env,argv[1], &data)) { return enif_make_badarg(env); @@ -2647,8 +2254,6 @@ static ERL_NIF_TERM rc4_set_key(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg ErlNifBinary key; ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - if (!enif_inspect_iolist_as_binary(env,argv[0], &key)) { return enif_make_badarg(env); } @@ -2664,8 +2269,6 @@ static ERL_NIF_TERM rc4_encrypt_with_state(ErlNifEnv* env, int argc, const ERL_N RC4_KEY* rc4_key; ERL_NIF_TERM new_state, new_data; - CHECK_OSE_CRYPTO(); - if (!enif_inspect_iolist_as_binary(env,argv[0], &state) || state.size != sizeof(RC4_KEY) || !enif_inspect_iolist_as_binary(env,argv[1], &data)) { @@ -2679,35 +2282,6 @@ static ERL_NIF_TERM rc4_encrypt_with_state(ErlNifEnv* env, int argc, const ERL_N return enif_make_tuple2(env,new_state,new_data); } -static ERL_NIF_TERM rc2_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key,IVec,Data,IsEncrypt) */ - ErlNifBinary key_bin, ivec_bin, data_bin; - RC2_KEY rc2_key; - ERL_NIF_TERM ret; - unsigned char iv_copy[8]; - - CHECK_OSE_CRYPTO(); - - if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin) - || (key_bin.size != 5 && key_bin.size != 8 && key_bin.size != 16) - || !enif_inspect_binary(env, argv[1], &ivec_bin) - || ivec_bin.size != 8 - || !enif_inspect_iolist_as_binary(env, argv[2], &data_bin) - || data_bin.size % 8 != 0) { - return enif_make_badarg(env); - } - - RC2_set_key(&rc2_key, key_bin.size, key_bin.data, key_bin.size*8); - memcpy(iv_copy, ivec_bin.data, 8); - RC2_cbc_encrypt(data_bin.data, - enif_make_new_binary(env, data_bin.size, &ret), - data_bin.size, &rc2_key, - iv_copy, - (argv[3] == atom_true)); - CONSUME_REDS(env,data_bin); - return ret; -} - static int get_rsa_private_key(ErlNifEnv* env, ERL_NIF_TERM key, RSA *rsa) { /* key=[E,N,D]|[E,N,D,P1,P2,E1,E2,C] */ @@ -2737,42 +2311,32 @@ static int get_rsa_private_key(ErlNifEnv* env, ERL_NIF_TERM key, RSA *rsa) } static ERL_NIF_TERM rsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Type, Data|{digest,Digest}, Key=[E,N,D]|[E,N,D,P1,P2,E1,E2,C]) */ - ErlNifBinary data_bin, ret_bin; - unsigned char hmacbuf[SHA512_LEN]; - unsigned rsa_s_len; - RSA* rsa; - int i; - const ERL_NIF_TERM* tpl_terms; - int tpl_arity; +{/* (Type, Digest, Key=[E,N,D]|[E,N,D,P1,P2,E1,E2,C]) */ + ErlNifBinary digest_bin, ret_bin; +#if OPENSSL_VERSION_NUMBER >= 0x1000000fL + EVP_PKEY *pkey; + EVP_PKEY_CTX *ctx; + size_t rsa_s_len; +#else + unsigned rsa_s_len, len; +#endif + RSA *rsa; + int i; struct digest_type_t *digp; - unsigned char* digest; - - CHECK_OSE_CRYPTO(); + const EVP_MD *md; digp = get_digest_type(argv[0]); if (!digp) { return enif_make_badarg(env); } - if (!digp->len) { + if (!digp->md_func) { return atom_notsup; } + md = digp->md_func(); - if (enif_get_tuple(env, argv[1], &tpl_arity, &tpl_terms)) { - if (tpl_arity != 2 || tpl_terms[0] != atom_digest - || !enif_inspect_binary(env, tpl_terms[1], &data_bin) - || data_bin.size != digp->len) { - - return enif_make_badarg(env); - } - digest = data_bin.data; - } - else { - if (!enif_inspect_binary(env,argv[1],&data_bin)) { - return enif_make_badarg(env); - } - digest = hmacbuf; - digp->funcp(data_bin.data, data_bin.size, digest); + if (!enif_inspect_binary(env,argv[1],&digest_bin) + || digest_bin.size != EVP_MD_size(md)) { + return enif_make_badarg(env); } rsa = RSA_new(); @@ -2782,14 +2346,33 @@ static ERL_NIF_TERM rsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar } +#if OPENSSL_VERSION_NUMBER >= 0x1000000fL + pkey = EVP_PKEY_new(); + EVP_PKEY_set1_RSA(pkey, rsa); + rsa_s_len=(size_t)EVP_PKEY_size(pkey); + enif_alloc_binary(rsa_s_len, &ret_bin); + + ctx = EVP_PKEY_CTX_new(pkey, NULL); + EVP_PKEY_sign_init(ctx); + EVP_PKEY_CTX_set_rsa_padding(ctx, RSA_PKCS1_PADDING); + EVP_PKEY_CTX_set_signature_md(ctx, md); + + i = EVP_PKEY_sign(ctx, ret_bin.data, &rsa_s_len, + digest_bin.data, digest_bin.size); + ASSERT(i<=0 || rsa_s_len <= ret_bin.size); + EVP_PKEY_CTX_free(ctx); + EVP_PKEY_free(pkey); +#else enif_alloc_binary(RSA_size(rsa), &ret_bin); + len = EVP_MD_size(md); - ERL_VALGRIND_ASSERT_MEM_DEFINED(digest, digp->len); - i = RSA_sign(digp->NID_type, digest, digp->len, + ERL_VALGRIND_ASSERT_MEM_DEFINED(digest_bin.data, len); + i = RSA_sign(md->type, digest_bin.data, len, ret_bin.data, &rsa_s_len, rsa); +#endif RSA_free(rsa); - if (i) { + if (i > 0) { ERL_VALGRIND_MAKE_MEM_DEFINED(ret_bin.data, rsa_s_len); if (rsa_s_len != ret_bin.size) { enif_realloc_binary(&ret_bin, rsa_s_len); @@ -2805,44 +2388,16 @@ static ERL_NIF_TERM rsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar static ERL_NIF_TERM dss_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (DigesType|none, Data|{digest,Digest}, Key=[P,Q,G,PrivKey]) */ - ErlNifBinary data_bin, ret_bin; +{/* (sha, Digest, Key=[P,Q,G,PrivKey]) */ + ErlNifBinary digest_bin, ret_bin; ERL_NIF_TERM head, tail; - unsigned char hmacbuf[SHA_DIGEST_LENGTH]; unsigned int dsa_s_len; - const ERL_NIF_TERM* tpl_terms; - int tpl_arity; - unsigned char* digest = NULL; DSA* dsa; int i; - CHECK_OSE_CRYPTO(); - - if (argv[0] == atom_sha) { - if (enif_get_tuple(env, argv[1], &tpl_arity, &tpl_terms)) { - if (tpl_arity != 2 || tpl_terms[0] != atom_digest - || !enif_inspect_binary(env, tpl_terms[1], &data_bin) - || data_bin.size != SHA_DIGEST_LENGTH) { - - return enif_make_badarg(env); - } - digest = data_bin.data; - } - else { - if (!enif_inspect_binary(env,argv[1],&data_bin)) { - return enif_make_badarg(env); - } - SHA1(data_bin.data, data_bin.size, hmacbuf); - digest = hmacbuf; - } - } - else if (argv[0] == atom_none - && enif_inspect_binary(env,argv[1],&data_bin) - && data_bin.size == SHA_DIGEST_LENGTH) { - - digest = data_bin.data; - } - else { + if (!argv[0] == atom_sha + || !enif_inspect_binary(env, argv[1], &digest_bin) + || digest_bin.size != SHA_DIGEST_LENGTH) { return enif_make_badarg(env); } @@ -2863,7 +2418,7 @@ static ERL_NIF_TERM dss_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar } enif_alloc_binary(DSA_size(dsa), &ret_bin); - i = DSA_sign(NID_sha1, digest, SHA_DIGEST_LENGTH, + i = DSA_sign(NID_sha1, digest_bin.data, SHA_DIGEST_LENGTH, ret_bin.data, &dsa_s_len, dsa); DSA_free(dsa); if (i) { @@ -2903,8 +2458,6 @@ static ERL_NIF_TERM rsa_public_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TER int padding, i; RSA* rsa; - CHECK_OSE_CRYPTO(); - rsa = RSA_new(); if (!enif_inspect_binary(env, argv[0], &data_bin) @@ -2953,8 +2506,6 @@ static ERL_NIF_TERM rsa_private_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TE int padding, i; RSA* rsa; - CHECK_OSE_CRYPTO(); - rsa = RSA_new(); if (!enif_inspect_binary(env, argv[0], &data_bin) @@ -3001,8 +2552,6 @@ static ERL_NIF_TERM dh_generate_parameters_nif(ErlNifEnv* env, int argc, const E unsigned char *p_ptr, *g_ptr; ERL_NIF_TERM ret_p, ret_g; - CHECK_OSE_CRYPTO(); - if (!enif_get_int(env, argv[0], &prime_len) || !enif_get_int(env, argv[1], &generator)) { @@ -3030,8 +2579,6 @@ static ERL_NIF_TERM dh_check(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] int i; ERL_NIF_TERM ret, head, tail; - CHECK_OSE_CRYPTO(); - dh_params = DH_new(); if (!enif_get_list_cell(env, argv[0], &head, &tail) @@ -3066,8 +2613,6 @@ static ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_ ERL_NIF_TERM ret, ret_pub, ret_prv, head, tail; int mpint; /* 0 or 4 */ - CHECK_OSE_CRYPTO(); - dh_params = DH_new(); if (!(get_bn_from_bin(env, argv[0], &dh_params->priv_key) @@ -3112,8 +2657,6 @@ static ERL_NIF_TERM dh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_T ErlNifBinary ret_bin; ERL_NIF_TERM ret, head, tail; - CHECK_OSE_CRYPTO(); - dh_params = DH_new(); if (!get_bn_from_bin(env, argv[0], &pubkey) @@ -3136,7 +2679,7 @@ static ERL_NIF_TERM dh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_T ret = enif_make_binary(env, &ret_bin); } else { - enif_release_binary(&ret_bin); + enif_release_binary(&ret_bin); ret = atom_error; } } @@ -3154,8 +2697,6 @@ static ERL_NIF_TERM srp_value_B_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM unsigned dlen; ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - if (!get_bn_from_bin(env, argv[0], &bn_multiplier) || !get_bn_from_bin(env, argv[1], &bn_verifier) || !get_bn_from_bin(env, argv[2], &bn_generator) @@ -3216,8 +2757,6 @@ static ERL_NIF_TERM srp_user_secret_nif(ErlNifEnv* env, int argc, const ERL_NIF_ unsigned dlen; ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - if (!get_bn_from_bin(env, argv[0], &bn_a) || !get_bn_from_bin(env, argv[1], &bn_u) || !get_bn_from_bin(env, argv[2], &bn_B) @@ -3297,8 +2836,6 @@ static ERL_NIF_TERM srp_host_secret_nif(ErlNifEnv* env, int argc, const ERL_NIF_ unsigned dlen; ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); - if (!get_bn_from_bin(env, argv[0], &bn_verifier) || !get_bn_from_bin(env, argv[1], &bn_b) || !get_bn_from_bin(env, argv[2], &bn_u) @@ -3351,103 +2888,6 @@ static ERL_NIF_TERM srp_host_secret_nif(ErlNifEnv* env, int argc, const ERL_NIF_ return ret; } -static ERL_NIF_TERM bf_cfb64_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, Ivec, Data, IsEncrypt) */ - ErlNifBinary key_bin, ivec_bin, data_bin; - BF_KEY bf_key; /* blowfish key 8 */ - unsigned char bf_tkey[8]; /* blowfish ivec */ - int bf_n = 0; /* blowfish ivec pos */ - ERL_NIF_TERM ret; - - CHECK_OSE_CRYPTO(); - - if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin) - || !enif_inspect_binary(env, argv[1], &ivec_bin) - || ivec_bin.size != 8 - || !enif_inspect_iolist_as_binary(env, argv[2], &data_bin)) { - return enif_make_badarg(env); - } - - BF_set_key(&bf_key, key_bin.size, key_bin.data); - memcpy(bf_tkey, ivec_bin.data, 8); - BF_cfb64_encrypt(data_bin.data, enif_make_new_binary(env,data_bin.size,&ret), - data_bin.size, &bf_key, bf_tkey, &bf_n, - (argv[3] == atom_true ? BF_ENCRYPT : BF_DECRYPT)); - CONSUME_REDS(env,data_bin); - return ret; -} - -static ERL_NIF_TERM bf_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, Ivec, Data, IsEncrypt) */ - ErlNifBinary key_bin, ivec_bin, data_bin; - BF_KEY bf_key; /* blowfish key 8 */ - unsigned char bf_tkey[8]; /* blowfish ivec */ - ERL_NIF_TERM ret; - - CHECK_OSE_CRYPTO(); - - if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin) - || !enif_inspect_binary(env, argv[1], &ivec_bin) - || ivec_bin.size != 8 - || !enif_inspect_iolist_as_binary(env, argv[2], &data_bin) - || data_bin.size % 8 != 0) { - return enif_make_badarg(env); - } - - BF_set_key(&bf_key, key_bin.size, key_bin.data); - memcpy(bf_tkey, ivec_bin.data, 8); - BF_cbc_encrypt(data_bin.data, enif_make_new_binary(env,data_bin.size,&ret), - data_bin.size, &bf_key, bf_tkey, - (argv[3] == atom_true ? BF_ENCRYPT : BF_DECRYPT)); - CONSUME_REDS(env,data_bin); - return ret; -} - -static ERL_NIF_TERM bf_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, Data, IsEncrypt) */ - ErlNifBinary key_bin, data_bin; - BF_KEY bf_key; /* blowfish key 8 */ - ERL_NIF_TERM ret; - - CHECK_OSE_CRYPTO(); - - if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin) - || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin) - || data_bin.size < 8) { - return enif_make_badarg(env); - } - BF_set_key(&bf_key, key_bin.size, key_bin.data); - BF_ecb_encrypt(data_bin.data, enif_make_new_binary(env,data_bin.size,&ret), - &bf_key, (argv[2] == atom_true ? BF_ENCRYPT : BF_DECRYPT)); - CONSUME_REDS(env,data_bin); - return ret; -} - -static ERL_NIF_TERM blowfish_ofb64_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, IVec, Data) */ - ErlNifBinary key_bin, ivec_bin, data_bin; - BF_KEY bf_key; /* blowfish key 8 */ - unsigned char bf_tkey[8]; /* blowfish ivec */ - int bf_n = 0; /* blowfish ivec pos */ - ERL_NIF_TERM ret; - - CHECK_OSE_CRYPTO(); - - if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin) - || !enif_inspect_binary(env, argv[1], &ivec_bin) - || ivec_bin.size != 8 - || !enif_inspect_iolist_as_binary(env, argv[2], &data_bin)) { - return enif_make_badarg(env); - } - - BF_set_key(&bf_key, key_bin.size, key_bin.data); - memcpy(bf_tkey, ivec_bin.data, 8); - BF_ofb64_encrypt(data_bin.data, enif_make_new_binary(env,data_bin.size,&ret), - data_bin.size, &bf_key, bf_tkey, &bf_n); - CONSUME_REDS(env,data_bin); - return ret; -} - #if defined(HAVE_EC) static EC_KEY* ec_key_new(ErlNifEnv* env, ERL_NIF_TERM curve_arg) { @@ -3566,6 +3006,9 @@ static EC_KEY* ec_key_new(ErlNifEnv* env, ERL_NIF_TERM curve_arg) } else goto out_err; + if (!group) + goto out_err; + if (enif_inspect_binary(env, prime[2], &seed)) { EC_GROUP_set_seed(group, seed.data, seed.size); } @@ -3756,8 +3199,6 @@ static ERL_NIF_TERM ec_key_generate(ErlNifEnv* env, int argc, const ERL_NIF_TERM ERL_NIF_TERM priv_key; ERL_NIF_TERM pub_key = atom_undefined; - CHECK_OSE_CRYPTO(); - if (!get_ec_key(env, argv[0], argv[1], atom_undefined, &key)) goto badarg; @@ -3787,51 +3228,33 @@ badarg: } static ERL_NIF_TERM ecdsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Type, Data|{digest,Digest}, Curve, Key) */ +{/* (Type, Digest, Curve, Key) */ #if defined(HAVE_EC) - ErlNifBinary data_bin, ret_bin; - unsigned char hmacbuf[SHA_DIGEST_LENGTH]; + ErlNifBinary digest_bin, ret_bin; unsigned int dsa_s_len; EC_KEY* key = NULL; - int i; - const ERL_NIF_TERM* tpl_terms; - int tpl_arity; + int i, len; struct digest_type_t *digp; - unsigned char* digest; - - CHECK_OSE_CRYPTO(); + const EVP_MD *md; digp = get_digest_type(argv[0]); if (!digp) { return enif_make_badarg(env); } - if (!digp->len) { + if (!digp->md_func) { return atom_notsup; } + md = digp->md_func(); + len = EVP_MD_size(md); - if (!get_ec_key(env, argv[2], argv[3], atom_undefined, &key)) + if (!enif_inspect_binary(env,argv[1],&digest_bin) + || digest_bin.size != len + || !get_ec_key(env, argv[2], argv[3], atom_undefined, &key)) goto badarg; - if (enif_get_tuple(env, argv[1], &tpl_arity, &tpl_terms)) { - if (tpl_arity != 2 || tpl_terms[0] != atom_digest - || !enif_inspect_binary(env, tpl_terms[1], &data_bin) - || data_bin.size != digp->len) { - - goto badarg; - } - digest = data_bin.data; - } - else { - if (!enif_inspect_binary(env,argv[1],&data_bin)) { - goto badarg; - } - digest = hmacbuf; - digp->funcp(data_bin.data, data_bin.size, digest); - } - enif_alloc_binary(ECDSA_size(key), &ret_bin); - i = ECDSA_sign(digp->NID_type, digest, digp->len, + i = ECDSA_sign(md->type, digest_bin.data, len, ret_bin.data, &dsa_s_len, key); EC_KEY_free(key); @@ -3856,50 +3279,32 @@ badarg: } static ERL_NIF_TERM ecdsa_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Type, Data|{digest,Digest}, Signature, Curve, Key) */ +{/* (Type, Digest, Signature, Curve, Key) */ #if defined(HAVE_EC) - ErlNifBinary data_bin, sign_bin; - unsigned char hmacbuf[SHA512_LEN]; - int i; + ErlNifBinary digest_bin, sign_bin; + int i, len; EC_KEY* key = NULL; const ERL_NIF_TERM type = argv[0]; - const ERL_NIF_TERM* tpl_terms; - int tpl_arity; - struct digest_type_t* digp = NULL; - unsigned char* digest = NULL; - - CHECK_OSE_CRYPTO(); + struct digest_type_t *digp = NULL; + const EVP_MD *md; digp = get_digest_type(type); if (!digp) { return enif_make_badarg(env); } - if (!digp->len) { + if (!digp->md_func) { return atom_notsup; } + md = digp->md_func(); + len = EVP_MD_size(md); - if (!enif_inspect_binary(env, argv[2], &sign_bin) + if (!enif_inspect_binary(env, argv[1], &digest_bin) + || digest_bin.size != len + || !enif_inspect_binary(env, argv[2], &sign_bin) || !get_ec_key(env, argv[3], atom_undefined, argv[4], &key)) goto badarg; - if (enif_get_tuple(env, argv[1], &tpl_arity, &tpl_terms)) { - if (tpl_arity != 2 || tpl_terms[0] != atom_digest - || !enif_inspect_binary(env, tpl_terms[1], &data_bin) - || data_bin.size != digp->len) { - - goto badarg; - } - digest = data_bin.data; - } - else if (enif_inspect_binary(env, argv[1], &data_bin)) { - digest = hmacbuf; - digp->funcp(data_bin.data, data_bin.size, digest); - } - else { - goto badarg; - } - - i = ECDSA_verify(digp->NID_type, digest, digp->len, + i = ECDSA_verify(md->type, digest_bin.data, len, sign_bin.data, sign_bin.size, key); EC_KEY_free(key); @@ -3933,8 +3338,6 @@ static ERL_NIF_TERM ecdh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF EC_POINT *my_ecpoint; EC_KEY *other_ecdh = NULL; - CHECK_OSE_CRYPTO(); - if (!get_ec_key(env, argv[1], argv[2], atom_undefined, &key)) return enif_make_badarg(env); @@ -3978,253 +3381,9 @@ out_err: static ERL_NIF_TERM rand_seed_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { ErlNifBinary seed_bin; - CHECK_OSE_CRYPTO(); + if (!enif_inspect_binary(env, argv[0], &seed_bin)) return enif_make_badarg(env); RAND_seed(seed_bin.data,seed_bin.size); return atom_ok; } - - -/* HMAC */ - -static void hmac_md5(unsigned char *key, int klen, unsigned char *dbuf, int dlen, - unsigned char *hmacbuf) -{ - MD5_CTX ctx; - char ipad[HMAC_INT_LEN]; - char opad[HMAC_INT_LEN]; - unsigned char nkey[MD5_LEN]; - int i; - - /* Change key if longer than 64 bytes */ - if (klen > HMAC_INT_LEN) { - MD5(key, klen, nkey); - key = nkey; - klen = MD5_LEN; - } - - memset(ipad, '\0', sizeof(ipad)); - memset(opad, '\0', sizeof(opad)); - memcpy(ipad, key, klen); - memcpy(opad, key, klen); - - for (i = 0; i < HMAC_INT_LEN; i++) { - ipad[i] ^= HMAC_IPAD; - opad[i] ^= HMAC_OPAD; - } - - /* inner MD5 */ - MD5_Init(&ctx); - MD5_Update(&ctx, ipad, HMAC_INT_LEN); - MD5_Update(&ctx, dbuf, dlen); - MD5_Final((unsigned char *) hmacbuf, &ctx); - /* outer MD5 */ - MD5_Init(&ctx); - MD5_Update(&ctx, opad, HMAC_INT_LEN); - MD5_Update(&ctx, hmacbuf, MD5_LEN); - MD5_Final((unsigned char *) hmacbuf, &ctx); -} - -static void hmac_sha1(unsigned char *key, int klen, - unsigned char *dbuf, int dlen, - unsigned char *hmacbuf) -{ - SHA_CTX ctx; - char ipad[HMAC_INT_LEN]; - char opad[HMAC_INT_LEN]; - unsigned char nkey[SHA_LEN]; - int i; - - /* Change key if longer than 64 bytes */ - if (klen > HMAC_INT_LEN) { - SHA1(key, klen, nkey); - key = nkey; - klen = SHA_LEN; - } - - memset(ipad, '\0', sizeof(ipad)); - memset(opad, '\0', sizeof(opad)); - memcpy(ipad, key, klen); - memcpy(opad, key, klen); - - for (i = 0; i < HMAC_INT_LEN; i++) { - ipad[i] ^= HMAC_IPAD; - opad[i] ^= HMAC_OPAD; - } - - /* inner SHA */ - SHA1_Init(&ctx); - SHA1_Update(&ctx, ipad, HMAC_INT_LEN); - SHA1_Update(&ctx, dbuf, dlen); - SHA1_Final((unsigned char *) hmacbuf, &ctx); - /* outer SHA */ - SHA1_Init(&ctx); - SHA1_Update(&ctx, opad, HMAC_INT_LEN); - SHA1_Update(&ctx, hmacbuf, SHA_LEN); - SHA1_Final((unsigned char *) hmacbuf, &ctx); -} - -#ifdef HAVE_SHA224 -static void hmac_sha224(unsigned char *key, int klen, - unsigned char *dbuf, int dlen, - unsigned char *hmacbuf) -{ - SHA256_CTX ctx; - char ipad[HMAC_INT_LEN]; - char opad[HMAC_INT_LEN]; - unsigned char nkey[SHA224_DIGEST_LENGTH]; - int i; - - /* Change key if longer than 64 bytes */ - if (klen > HMAC_INT_LEN) { - SHA224(key, klen, nkey); - key = nkey; - klen = SHA224_DIGEST_LENGTH; - } - - memset(ipad, '\0', sizeof(ipad)); - memset(opad, '\0', sizeof(opad)); - memcpy(ipad, key, klen); - memcpy(opad, key, klen); - - for (i = 0; i < HMAC_INT_LEN; i++) { - ipad[i] ^= HMAC_IPAD; - opad[i] ^= HMAC_OPAD; - } - - /* inner SHA */ - SHA224_Init(&ctx); - SHA224_Update(&ctx, ipad, HMAC_INT_LEN); - SHA224_Update(&ctx, dbuf, dlen); - SHA224_Final((unsigned char *) hmacbuf, &ctx); - /* outer SHA */ - SHA224_Init(&ctx); - SHA224_Update(&ctx, opad, HMAC_INT_LEN); - SHA224_Update(&ctx, hmacbuf, SHA224_DIGEST_LENGTH); - SHA224_Final((unsigned char *) hmacbuf, &ctx); -} -#endif - -#ifdef HAVE_SHA256 -static void hmac_sha256(unsigned char *key, int klen, - unsigned char *dbuf, int dlen, - unsigned char *hmacbuf) -{ - SHA256_CTX ctx; - char ipad[HMAC_INT_LEN]; - char opad[HMAC_INT_LEN]; - unsigned char nkey[SHA256_DIGEST_LENGTH]; - int i; - - /* Change key if longer than 64 bytes */ - if (klen > HMAC_INT_LEN) { - SHA256(key, klen, nkey); - key = nkey; - klen = SHA256_DIGEST_LENGTH; - } - - memset(ipad, '\0', sizeof(ipad)); - memset(opad, '\0', sizeof(opad)); - memcpy(ipad, key, klen); - memcpy(opad, key, klen); - - for (i = 0; i < HMAC_INT_LEN; i++) { - ipad[i] ^= HMAC_IPAD; - opad[i] ^= HMAC_OPAD; - } - - /* inner SHA */ - SHA256_Init(&ctx); - SHA256_Update(&ctx, ipad, HMAC_INT_LEN); - SHA256_Update(&ctx, dbuf, dlen); - SHA256_Final((unsigned char *) hmacbuf, &ctx); - /* outer SHA */ - SHA256_Init(&ctx); - SHA256_Update(&ctx, opad, HMAC_INT_LEN); - SHA256_Update(&ctx, hmacbuf, SHA256_DIGEST_LENGTH); - SHA256_Final((unsigned char *) hmacbuf, &ctx); -} -#endif - -#ifdef HAVE_SHA384 -static void hmac_sha384(unsigned char *key, int klen, - unsigned char *dbuf, int dlen, - unsigned char *hmacbuf) -{ - SHA512_CTX ctx; - char ipad[HMAC_INT2_LEN]; - char opad[HMAC_INT2_LEN]; - unsigned char nkey[SHA384_DIGEST_LENGTH]; - int i; - - /* Change key if longer than 64 bytes */ - if (klen > HMAC_INT2_LEN) { - SHA384(key, klen, nkey); - key = nkey; - klen = SHA384_DIGEST_LENGTH; - } - - memset(ipad, '\0', sizeof(ipad)); - memset(opad, '\0', sizeof(opad)); - memcpy(ipad, key, klen); - memcpy(opad, key, klen); - - for (i = 0; i < HMAC_INT2_LEN; i++) { - ipad[i] ^= HMAC_IPAD; - opad[i] ^= HMAC_OPAD; - } - - /* inner SHA */ - SHA384_Init(&ctx); - SHA384_Update(&ctx, ipad, HMAC_INT2_LEN); - SHA384_Update(&ctx, dbuf, dlen); - SHA384_Final((unsigned char *) hmacbuf, &ctx); - /* outer SHA */ - SHA384_Init(&ctx); - SHA384_Update(&ctx, opad, HMAC_INT2_LEN); - SHA384_Update(&ctx, hmacbuf, SHA384_DIGEST_LENGTH); - SHA384_Final((unsigned char *) hmacbuf, &ctx); -} -#endif - -#ifdef HAVE_SHA512 -static void hmac_sha512(unsigned char *key, int klen, - unsigned char *dbuf, int dlen, - unsigned char *hmacbuf) -{ - SHA512_CTX ctx; - char ipad[HMAC_INT2_LEN]; - char opad[HMAC_INT2_LEN]; - unsigned char nkey[SHA512_DIGEST_LENGTH]; - int i; - - /* Change key if longer than 64 bytes */ - if (klen > HMAC_INT2_LEN) { - SHA512(key, klen, nkey); - key = nkey; - klen = SHA512_DIGEST_LENGTH; - } - - memset(ipad, '\0', sizeof(ipad)); - memset(opad, '\0', sizeof(opad)); - memcpy(ipad, key, klen); - memcpy(opad, key, klen); - - for (i = 0; i < HMAC_INT2_LEN; i++) { - ipad[i] ^= HMAC_IPAD; - opad[i] ^= HMAC_OPAD; - } - - /* inner SHA */ - SHA512_Init(&ctx); - SHA512_Update(&ctx, ipad, HMAC_INT2_LEN); - SHA512_Update(&ctx, dbuf, dlen); - SHA512_Final((unsigned char *) hmacbuf, &ctx); - /* outer SHA */ - SHA512_Init(&ctx); - SHA512_Update(&ctx, opad, HMAC_INT2_LEN); - SHA512_Update(&ctx, hmacbuf, SHA512_DIGEST_LENGTH); - SHA512_Final((unsigned char *) hmacbuf, &ctx); -} -#endif diff --git a/lib/crypto/c_src/crypto_callback.c b/lib/crypto/c_src/crypto_callback.c index e0de16074c..af9545bd63 100644 --- a/lib/crypto/c_src/crypto_callback.c +++ b/lib/crypto/c_src/crypto_callback.c @@ -43,6 +43,10 @@ #ifdef __WIN32__ # define DLLEXPORT __declspec(dllexport) +#elif defined(__GNUC__) && __GNUC__ >= 4 +# define DLLEXPORT __attribute__ ((visibility("default"))) +#elif defined (__SUNPRO_C) && (__SUNPRO_C >= 0x550) +# define DLLEXPORT __global #else # define DLLEXPORT #endif @@ -51,8 +55,6 @@ DLLEXPORT struct crypto_callbacks* get_crypto_callbacks(int nlocks); -static ErlNifRWLock** lock_vec = NULL; /* Static locks used by openssl */ - static void nomem(size_t size, const char* op) { fprintf(stderr, "Out of memory abort. Crypto failed to %s %zu bytes.\r\n", @@ -84,6 +86,8 @@ static void crypto_free(void* ptr) #ifdef OPENSSL_THREADS /* vvvvvvvvvvvvvvv OPENSSL_THREADS vvvvvvvvvvvvvvvv */ +static ErlNifRWLock** lock_vec = NULL; /* Static locks used by openssl */ + #include <openssl/crypto.h> static INLINE void locking(int mode, ErlNifRWLock* lock) diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml index 563a090e98..d3e827b3e6 100644 --- a/lib/crypto/doc/src/crypto.xml +++ b/lib/crypto/doc/src/crypto.xml @@ -135,9 +135,8 @@ <code>stream_cipher() = rc4 | aes_ctr </code> - <code>block_cipher() = aes_cbc128 | aes_cfb8 | aes_cfb128 | aes_ige256 | blowfish_cbc | - blowfish_cfb64 | des_cbc | des_cfb | des3_cbc | des3_cbf - | des_ede3 | rc2_cbc </code> + <code>block_cipher() = aes_cbc | aes_cfb8 | aes_cfb128 | aes_ige256 | blowfish_cbc | + blowfish_cfb64 | des_cbc | des_cfb | des3_cbc | des3_cbf | des_ede3 | rc2_cbc </code> <code>aead_cipher() = aes_gcm | chacha20_poly1305 </code> @@ -160,8 +159,9 @@ <code> hash_algorithms() = md5 | ripemd160 | sha | sha224 | sha256 | sha384 | sha512 </code> <p>md4 is also supported for hash_init/1 and hash/2. Note that both md4 and md5 are recommended only for compatibility with existing applications. </p> - <code> cipher_algorithms() = des_cbc | des_cfb | des3_cbc | des3_cbf | des_ede3 | - blowfish_cbc | blowfish_cfb64 | aes_cbc128 | aes_cfb8 | aes_cfb128| aes_cbc256 | aes_ige256 | aes_gcm | chacha20_poly1305 | rc2_cbc | aes_ctr| rc4 </code> + <code> cipher_algorithms() = aes_cbc | aes_cfb8 | aes_cfb128 | aes_ctr | aes_gcm | + aes_ige256 | blowfish_cbc | blowfish_cfb64 | chacha20_poly1305 | des_cbc | des_cfb | + des3_cbc | des3_cbf | des_ede3 | rc2_cbc | rc4 </code> <code> public_key_algorithms() = rsa |dss | ecdsa | dh | ecdh | ec_gf2m</code> <p>Note that ec_gf2m is not strictly a public key algorithm, but a restriction on what curves are supported with ecdsa and ecdh. diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index 38e71591f3..3e24ff2b0a 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -210,10 +210,8 @@ supports()-> {Hashs, PubKeys, Ciphers} = algorithms(), [{hashs, Hashs}, - {ciphers, [des_cbc, des_cfb, des3_cbc, des_ede3, blowfish_cbc, - blowfish_cfb64, blowfish_ofb64, blowfish_ecb, aes_cbc128, aes_cfb8, aes_cfb128, - aes_cbc256, rc2_cbc, aes_ctr, rc4, aes_ecb] ++ Ciphers}, - {public_keys, [rsa, dss, dh, srp] ++ PubKeys} + {ciphers, Ciphers}, + {public_keys, PubKeys} ]. info_lib() -> ?nif_stub. @@ -222,20 +220,14 @@ info_lib() -> ?nif_stub. hash(Hash, Data0) -> Data = iolist_to_binary(Data0), - MaxByts = max_bytes(), - hash(Hash, Data, erlang:byte_size(Data), MaxByts, initial). + MaxBytes = max_bytes(), + hash(Hash, Data, erlang:byte_size(Data), MaxBytes). -spec hash_init('md5'|'md4'|'ripemd160'| 'sha'|'sha224'|'sha256'|'sha384'|'sha512') -> any(). -hash_init(md5) -> {md5, md5_init()}; -hash_init(md4) -> {md4, md4_init()}; -hash_init(sha) -> {sha, sha_init()}; -hash_init(ripemd160) -> {ripemd160, ripemd160_init()}; -hash_init(sha224) -> {sha224, sha224_init()}; -hash_init(sha256) -> {sha256, sha256_init()}; -hash_init(sha384) -> {sha384, sha384_init()}; -hash_init(sha512) -> {sha512, sha512_init()}. +hash_init(Hash) -> + notsup_to_error(hash_init_nif(Hash)). -spec hash_update(_, iodata()) -> any(). @@ -246,14 +238,8 @@ hash_update(State, Data0) -> -spec hash_final(_) -> binary(). -hash_final({md5,Context}) -> md5_final(Context); -hash_final({md4,Context}) -> md4_final(Context); -hash_final({sha,Context}) -> sha_final(Context); -hash_final({ripemd160,Context}) -> ripemd160_final(Context); -hash_final({sha224,Context}) -> sha224_final(Context); -hash_final({sha256,Context}) -> sha256_final(Context); -hash_final({sha384,Context}) -> sha384_final(Context); -hash_final({sha512,Context}) -> sha512_final(Context). +hash_final(State) -> + notsup_to_error(hash_final_nif(State)). -spec hmac(_, iodata(), iodata()) -> binary(). @@ -265,151 +251,132 @@ hash_final({sha512,Context}) -> sha512_final(Context). hmac(Type, Key, Data0) -> Data = iolist_to_binary(Data0), - hmac(Type, Key, Data, undefined, erlang:byte_size(Data), max_bytes(), initial). + hmac(Type, Key, Data, undefined, erlang:byte_size(Data), max_bytes()). hmac(Type, Key, Data0, MacSize) -> Data = iolist_to_binary(Data0), - hmac(Type, Key, Data, MacSize, erlang:byte_size(Data), max_bytes(), initial). - + hmac(Type, Key, Data, MacSize, erlang:byte_size(Data), max_bytes()). -hmac_init(_Type, _Key) -> ?nif_stub. +hmac_init(Type, Key) -> + notsup_to_error(hmac_init_nif(Type, Key)). hmac_update(State, Data0) -> Data = iolist_to_binary(Data0), hmac_update(State, Data, erlang:byte_size(Data), max_bytes()). -hmac_final(_Context) -> ? nif_stub. -hmac_final_n(_Context, _HashLen) -> ? nif_stub. + +hmac_final(Context) -> + notsup_to_error(hmac_final_nif(Context)). +hmac_final_n(Context, HashLen) -> + notsup_to_error(hmac_final_nif(Context, HashLen)). %% Ecrypt/decrypt %%% --spec block_encrypt(des_cbc | des_cfb | des3_cbc | des3_cbf | des_ede3 | blowfish_cbc | - blowfish_cfb64 | aes_cbc128 | aes_cfb8 | aes_cfb128 | aes_cbc256 | rc2_cbc, +-spec block_encrypt(des_cbc | des_cfb | + des3_cbc | des3_cbf | des_ede3 | + blowfish_cbc | blowfish_cfb64 | blowfish_ofb64 | + aes_cbc128 | aes_cfb8 | aes_cfb128 | aes_cbc256 | aes_ige256 | + aes_cbc | + rc2_cbc, Key::iodata(), Ivec::binary(), Data::iodata()) -> binary(); (aes_gcm | chacha20_poly1305, Key::iodata(), Ivec::binary(), {AAD::binary(), Data::iodata()}) -> {binary(), binary()}. -block_encrypt(des_cbc, Key, Ivec, Data) -> - des_cbc_encrypt(Key, Ivec, Data); -block_encrypt(des_cfb, Key, Ivec, Data) -> - des_cfb_encrypt(Key, Ivec, Data); -block_encrypt(des3_cbc, [Key1, Key2, Key3], Ivec, Data) -> - des3_cbc_encrypt(Key1, Key2, Key3, Ivec, Data); -block_encrypt(des3_cbf, [Key1, Key2, Key3], Ivec, Data) -> - des3_cfb_encrypt(Key1, Key2, Key3, Ivec, Data); -block_encrypt(des_ede3, [Key1, Key2, Key3], Ivec, Data) -> - des_ede3_cbc_encrypt(Key1, Key2, Key3, Ivec, Data); -block_encrypt(blowfish_cbc, Key, Ivec, Data) -> - blowfish_cbc_encrypt(Key, Ivec, Data); -block_encrypt(blowfish_cfb64, Key, Ivec, Data) -> - blowfish_cfb64_encrypt(Key, Ivec, Data); -block_encrypt(blowfish_ofb64, Key, Ivec, Data) -> - blowfish_ofb64_encrypt(Key, Ivec, Data); -block_encrypt(aes_cbc128, Key, Ivec, Data) -> - aes_cbc_128_encrypt(Key, Ivec, Data); -block_encrypt(aes_cbc256, Key, Ivec, Data) -> - aes_cbc_256_encrypt(Key, Ivec, Data); +block_encrypt(Type, Key, Ivec, Data) when Type =:= des_cbc; + Type =:= des_cfb; + Type =:= blowfish_cbc; + Type =:= blowfish_cfb64; + Type =:= blowfish_ofb64; + Type =:= aes_cbc128; + Type =:= aes_cfb8; + Type =:= aes_cfb128; + Type =:= aes_cbc256; + Type =:= aes_cbc; + Type =:= rc2_cbc -> + block_crypt_nif(Type, Key, Ivec, Data, true); +block_encrypt(Type, Key0, Ivec, Data) when Type =:= des3_cbc; + Type =:= des_ede3 -> + Key = check_des3_key(Key0), + block_crypt_nif(des_ede3_cbc, Key, Ivec, Data, true); +block_encrypt(des3_cbf, Key0, Ivec, Data) -> + Key = check_des3_key(Key0), + block_crypt_nif(des_ede3_cbf, Key, Ivec, Data, true); block_encrypt(aes_ige256, Key, Ivec, Data) -> - aes_ige_256_encrypt(Key, Ivec, Data); -block_encrypt(aes_cfb8, Key, Ivec, Data) -> - aes_cfb_8_encrypt(Key, Ivec, Data); -block_encrypt(aes_cfb128, Key, Ivec, Data) -> - aes_cfb_128_encrypt(Key, Ivec, Data); + aes_ige_crypt_nif(Key, Ivec, Data, true); block_encrypt(aes_gcm, Key, Ivec, {AAD, Data}) -> - case aes_gcm_encrypt(Key, Ivec, AAD, Data) of - notsup -> erlang:error(notsup); - Return -> Return - end; + aes_gcm_encrypt(Key, Ivec, AAD, Data); block_encrypt(chacha20_poly1305, Key, Ivec, {AAD, Data}) -> - case chacha20_poly1305_encrypt(Key, Ivec, AAD, Data) of - notsup -> erlang:error(notsup); - Return -> Return - end; -block_encrypt(rc2_cbc, Key, Ivec, Data) -> - rc2_cbc_encrypt(Key, Ivec, Data). - --spec block_decrypt(des_cbc | des_cfb | des3_cbc | des3_cbf | des_ede3 | blowfish_cbc | - blowfish_cfb64 | blowfish_ofb64 | aes_cbc128 | aes_cbc256 | aes_ige256 | - aes_cfb8 | aes_cfb128 | rc2_cbc, + chacha20_poly1305_encrypt(Key, Ivec, AAD, Data). + +-spec block_decrypt(des_cbc | des_cfb | + des3_cbc | des3_cbf | des_ede3 | + blowfish_cbc | blowfish_cfb64 | blowfish_ofb64 | + aes_cbc128 | aes_cfb8 | aes_cfb128 | aes_cbc256 | aes_ige256 | + aes_cbc | + rc2_cbc, Key::iodata(), Ivec::binary(), Data::iodata()) -> binary(); (aes_gcm | chacha20_poly1305, Key::iodata(), Ivec::binary(), {AAD::binary(), Data::iodata(), Tag::binary()}) -> binary() | error. -block_decrypt(des_cbc, Key, Ivec, Data) -> - des_cbc_decrypt(Key, Ivec, Data); -block_decrypt(des_cfb, Key, Ivec, Data) -> - des_cfb_decrypt(Key, Ivec, Data); -block_decrypt(des3_cbc, [Key1, Key2, Key3], Ivec, Data) -> - des3_cbc_decrypt(Key1, Key2, Key3, Ivec, Data); -block_decrypt(des3_cbf, [Key1, Key2, Key3], Ivec, Data) -> - des3_cfb_decrypt(Key1, Key2, Key3, Ivec, Data); -block_decrypt(des_ede3, [Key1, Key2, Key3], Ivec, Data) -> - des_ede3_cbc_decrypt(Key1, Key2, Key3, Ivec, Data); -block_decrypt(blowfish_cbc, Key, Ivec, Data) -> - blowfish_cbc_decrypt(Key, Ivec, Data); -block_decrypt(blowfish_cfb64, Key, Ivec, Data) -> - blowfish_cfb64_decrypt(Key, Ivec, Data); -block_decrypt(blowfish_ofb64, Key, Ivec, Data) -> - blowfish_ofb64_decrypt(Key, Ivec, Data); -block_decrypt(aes_cbc128, Key, Ivec, Data) -> - aes_cbc_128_decrypt(Key, Ivec, Data); -block_decrypt(aes_cbc256, Key, Ivec, Data) -> - aes_cbc_256_decrypt(Key, Ivec, Data); +block_decrypt(Type, Key, Ivec, Data) when Type =:= des_cbc; + Type =:= des_cfb; + Type =:= blowfish_cbc; + Type =:= blowfish_cfb64; + Type =:= blowfish_ofb64; + Type =:= aes_cbc; + Type =:= aes_cbc128; + Type =:= aes_cfb8; + Type =:= aes_cfb128; + Type =:= aes_cbc256; + Type =:= rc2_cbc -> + block_crypt_nif(Type, Key, Ivec, Data, false); +block_decrypt(Type, Key0, Ivec, Data) when Type =:= des3_cbc; + Type =:= des_ede3 -> + Key = check_des3_key(Key0), + block_crypt_nif(des_ede3_cbc, Key, Ivec, Data, false); +block_decrypt(des3_cbf, Key0, Ivec, Data) -> + Key = check_des3_key(Key0), + block_crypt_nif(des_ede3_cbf, Key, Ivec, Data, false); block_decrypt(aes_ige256, Key, Ivec, Data) -> - aes_ige_256_decrypt(Key, Ivec, Data); -block_decrypt(aes_cfb8, Key, Ivec, Data) -> - aes_cfb_8_decrypt(Key, Ivec, Data); -block_decrypt(aes_cfb128, Key, Ivec, Data) -> - aes_cfb_128_decrypt(Key, Ivec, Data); + notsup_to_error(aes_ige_crypt_nif(Key, Ivec, Data, false)); block_decrypt(aes_gcm, Key, Ivec, {AAD, Data, Tag}) -> - case aes_gcm_decrypt(Key, Ivec, AAD, Data, Tag) of - notsup -> erlang:error(notsup); - Return -> Return - end; + aes_gcm_decrypt(Key, Ivec, AAD, Data, Tag); block_decrypt(chacha20_poly1305, Key, Ivec, {AAD, Data, Tag}) -> - case chacha20_poly1305_decrypt(Key, Ivec, AAD, Data, Tag) of - notsup -> erlang:error(notsup); - Return -> Return - end; -block_decrypt(rc2_cbc, Key, Ivec, Data) -> - rc2_cbc_decrypt(Key, Ivec, Data). + chacha20_poly1305_decrypt(Key, Ivec, AAD, Data, Tag). -spec block_encrypt(des_ecb | blowfish_ecb | aes_ecb, Key::iodata(), Data::iodata()) -> binary(). -block_encrypt(des_ecb, Key, Data) -> - des_ecb_encrypt(Key, Data); -block_encrypt(blowfish_ecb, Key, Data) -> - blowfish_ecb_encrypt(Key, Data); -block_encrypt(aes_ecb, Key, Data) -> - aes_ecb_encrypt(Key, Data). +block_encrypt(Type, Key, Data) -> + block_crypt_nif(Type, Key, Data, true). -spec block_decrypt(des_ecb | blowfish_ecb | aes_ecb, Key::iodata(), Data::iodata()) -> binary(). -block_decrypt(des_ecb, Key, Data) -> - des_ecb_decrypt(Key, Data); -block_decrypt(blowfish_ecb, Key, Data) -> - blowfish_ecb_decrypt(Key, Data); -block_decrypt(aes_ecb, Key, Data) -> - aes_ecb_decrypt(Key, Data). +block_decrypt(Type, Key, Data) -> + block_crypt_nif(Type, Key, Data, false). -spec next_iv(des_cbc | des3_cbc | aes_cbc | aes_ige, Data::iodata()) -> binary(). -next_iv(des_cbc, Data) -> - des_cbc_ivec(Data); -next_iv(des3_cbc, Data) -> - des_cbc_ivec(Data); -next_iv(aes_cbc, Data) -> - aes_cbc_ivec(Data); -next_iv(aes_ige, Data) -> - aes_ige_ivec(Data). +next_iv(Type, Data) when is_binary(Data) -> + IVecSize = case Type of + des_cbc -> 8; + des3_cbc -> 8; + aes_cbc -> 16; + aes_ige -> 32 + end, + {_, IVec} = split_binary(Data, size(Data) - IVecSize), + IVec; +next_iv(Type, Data) when is_list(Data) -> + next_iv(Type, list_to_binary(Data)). -spec next_iv(des_cfb, Data::iodata(), Ivec::binary()) -> binary(). -next_iv(des_cfb, Data, Ivec) -> - des_cfb_ivec(Ivec, Data); +next_iv(des_cfb, Data, IVec) -> + IVecAndData = list_to_binary([IVec, Data]), + {_, NewIVec} = split_binary(IVecAndData, byte_size(IVecAndData) - 8), + NewIVec; next_iv(Type, Data, _Ivec) -> next_iv(Type, Data). stream_init(aes_ctr, Key, Ivec) -> {aes_ctr, aes_ctr_stream_init(Key, Ivec)}. stream_init(rc4, Key) -> - {rc4, rc4_set_key(Key)}. + {rc4, notsup_to_error(rc4_set_key(Key))}. stream_encrypt(State, Data0) -> Data = iolist_to_binary(Data0), @@ -485,35 +452,31 @@ verify(dss, none, Data, Signature, Key) when is_binary(Data) -> verify(dss, sha, {digest, Data}, Signature, Key); verify(Alg, Type, Data, Signature, Key) when is_binary(Data) -> verify(Alg, Type, {digest, hash(Type, Data)}, Signature, Key); -verify(dss, Type, Data, Signature, Key) -> - dss_verify_nif(Type, Data, Signature, map_ensure_int_as_bin(Key)); -verify(rsa, Type, DataOrDigest, Signature, Key) -> - case rsa_verify_nif(Type, DataOrDigest, Signature, map_ensure_int_as_bin(Key)) of - notsup -> erlang:error(notsup); - Bool -> Bool - end; -verify(ecdsa, Type, DataOrDigest, Signature, [Key, Curve]) -> - case ecdsa_verify_nif(Type, DataOrDigest, Signature, nif_curve_params(Curve), ensure_int_as_bin(Key)) of - notsup -> erlang:error(notsup); - Bool -> Bool - end. +verify(dss, Type, {digest, Digest}, Signature, Key) -> + dss_verify_nif(Type, Digest, Signature, map_ensure_int_as_bin(Key)); +verify(rsa, Type, {digest, Digest}, Signature, Key) -> + notsup_to_error( + rsa_verify_nif(Type, Digest, Signature, map_ensure_int_as_bin(Key))); +verify(ecdsa, Type, {digest, Digest}, Signature, [Key, Curve]) -> + notsup_to_error( + ecdsa_verify_nif(Type, Digest, Signature, nif_curve_params(Curve), ensure_int_as_bin(Key))). sign(dss, none, Data, Key) when is_binary(Data) -> sign(dss, sha, {digest, Data}, Key); sign(Alg, Type, Data, Key) when is_binary(Data) -> sign(Alg, Type, {digest, hash(Type, Data)}, Key); -sign(rsa, Type, DataOrDigest, Key) -> - case rsa_sign_nif(Type, DataOrDigest, map_ensure_int_as_bin(Key)) of - error -> erlang:error(badkey, [Type,DataOrDigest,Key]); +sign(rsa, Type, {digest, Digest}, Key) -> + case rsa_sign_nif(Type, Digest, map_ensure_int_as_bin(Key)) of + error -> erlang:error(badkey, [Type,Digest,Key]); Sign -> Sign end; -sign(dss, Type, DataOrDigest, Key) -> - case dss_sign_nif(Type, DataOrDigest, map_ensure_int_as_bin(Key)) of - error -> erlang:error(badkey, [DataOrDigest, Key]); +sign(dss, Type, {digest, Digest}, Key) -> + case dss_sign_nif(Type, Digest, map_ensure_int_as_bin(Key)) of + error -> erlang:error(badkey, [Digest, Key]); Sign -> Sign end; -sign(ecdsa, Type, DataOrDigest, [Key, Curve]) -> - case ecdsa_sign_nif(Type, DataOrDigest, nif_curve_params(Curve), ensure_int_as_bin(Key)) of - error -> erlang:error(badkey, [Type,DataOrDigest,Key]); +sign(ecdsa, Type, {digest, Digest}, [Key, Curve]) -> + case ecdsa_sign_nif(Type, Digest, nif_curve_params(Curve), ensure_int_as_bin(Key)) of + error -> erlang:error(badkey, [Type,Digest,Key]); Sign -> Sign end. @@ -618,8 +581,9 @@ compute_key(srp, HostPublic, {UserPublic, UserPrivate}, HostPubBin, Prime); [S] -> S end, + notsup_to_error( srp_user_secret_nif(ensure_int_as_bin(UserPrivate), Scrambler, HostPubBin, - Multiplier, Generator, DerivedKey, Prime); + Multiplier, Generator, DerivedKey, Prime)); compute_key(srp, UserPublic, {HostPublic, HostPrivate}, {host,[Verifier, Prime, Version | ScramblerArg]}) when @@ -631,8 +595,9 @@ compute_key(srp, UserPublic, {HostPublic, HostPrivate}, [] -> srp_scrambler(Version, UserPubBin, ensure_int_as_bin(HostPublic), Prime); [S] -> S end, + notsup_to_error( srp_host_secret_nif(Verifier, ensure_int_as_bin(HostPrivate), Scrambler, - UserPubBin, Prime); + UserPubBin, Prime)); compute_key(ecdh, Others, My, Curve) -> ecdh_compute_key_nif(ensure_int_as_bin(Others), @@ -677,7 +642,8 @@ on_load() -> end end, Lib = filename:join([PrivDir, "lib", LibName]), - Status = case erlang:load_nif(Lib, {?CRYPTO_NIF_VSN,path2bin(Lib)}) of + LibBin = path2bin(Lib), + Status = case erlang:load_nif(Lib, {?CRYPTO_NIF_VSN,LibBin}) of ok -> ok; {error, {load_failed, _}}=Error1 -> ArchLibDir = @@ -689,7 +655,8 @@ on_load() -> [] -> Error1; _ -> ArchLib = filename:join([ArchLibDir, LibName]), - erlang:load_nif(ArchLib, {?CRYPTO_NIF_VSN,path2bin(ArchLib)}) + ArchBin = path2bin(ArchLib), + erlang:load_nif(ArchLib, {?CRYPTO_NIF_VSN,ArchBin}) end; Error1 -> Error1 end, @@ -714,46 +681,30 @@ path2bin(Path) when is_list(Path) -> max_bytes() -> ?MAX_BYTES_TO_NIF. +notsup_to_error(notsup) -> + erlang:error(notsup); +notsup_to_error(Other) -> + Other. + %% HASH -------------------------------------------------------------------- -hash(Hash, Data, Size, Max, initial) when Size =< Max -> - do_hash(Hash, Data); -hash(State0, Data, Size, Max, continue) when Size =< Max -> - State = do_hash_update(State0, Data), - hash_final(State); -hash(Hash, Data, _Size, Max, initial) -> - <<Increment:Max/binary, Rest/binary>> = Data, +hash(Hash, Data, Size, Max) when Size =< Max -> + notsup_to_error(hash_nif(Hash, Data)); +hash(Hash, Data, Size, Max) -> State0 = hash_init(Hash), - State = do_hash_update(State0, Increment), - hash(State, Rest, erlang:byte_size(Rest), max_bytes(), continue); -hash(State0, Data, _Size, MaxByts, continue) -> - <<Increment:MaxByts/binary, Rest/binary>> = Data, - State = do_hash_update(State0, Increment), - hash(State, Rest, erlang:byte_size(Rest), max_bytes(), continue). - -do_hash(md5, Data) -> md5(Data); -do_hash(md4, Data) -> md4(Data); -do_hash(sha, Data) -> sha(Data); -do_hash(ripemd160, Data) -> ripemd160(Data); -do_hash(sha224, Data) -> sha224(Data); -do_hash(sha256, Data) -> sha256(Data); -do_hash(sha384, Data) -> sha384(Data); -do_hash(sha512, Data) -> sha512(Data). + State1 = hash_update(State0, Data, Size, Max), + hash_final(State1). hash_update(State, Data, Size, MaxBytes) when Size =< MaxBytes -> - do_hash_update(State, Data); + notsup_to_error(hash_update_nif(State, Data)); hash_update(State0, Data, _, MaxBytes) -> <<Increment:MaxBytes/binary, Rest/binary>> = Data, - State = do_hash_update(State0, Increment), + State = notsup_to_error(hash_update_nif(State0, Increment)), hash_update(State, Rest, erlang:byte_size(Rest), MaxBytes). -do_hash_update({md5,Context}, Data) -> {md5, md5_update(Context,Data)}; -do_hash_update({md4,Context}, Data) -> {md4, md4_update(Context,Data)}; -do_hash_update({sha,Context}, Data) -> {sha, sha_update(Context,Data)}; -do_hash_update({ripemd160,Context}, Data) -> {ripemd160, ripemd160_update(Context,Data)}; -do_hash_update({sha224,Context}, Data) -> {sha224, sha224_update(Context,Data)}; -do_hash_update({sha256,Context}, Data) -> {sha256, sha256_update(Context,Data)}; -do_hash_update({sha384,Context}, Data) -> {sha384, sha384_update(Context,Data)}; -do_hash_update({sha512,Context}, Data) -> {sha512, sha512_update(Context,Data)}. +hash_nif(_Hash, _Data) -> ?nif_stub. +hash_init_nif(_Hash) -> ?nif_stub. +hash_update_nif(_State, _Data) -> ?nif_stub. +hash_final_nif(_State) -> ?nif_stub. %% @@ -765,10 +716,14 @@ do_hash_update({sha512,Context}, Data) -> {sha512, sha512_update(Context,Data -spec md5_update(binary(), iodata()) -> binary(). -spec md5_final(binary()) -> binary(). -md5(_Data) -> ?nif_stub. -md5_init() -> ?nif_stub. -md5_update(_Context, _Data) -> ?nif_stub. -md5_final(_Context) -> ?nif_stub. +md5(Data) -> + hash(md5, Data). +md5_init() -> + hash_init(md5). +md5_update(Context, Data) -> + hash_update(Context, Data). +md5_final(Context) -> + hash_final(Context). %% %% MD4 @@ -778,24 +733,14 @@ md5_final(_Context) -> ?nif_stub. -spec md4_update(binary(), iodata()) -> binary(). -spec md4_final(binary()) -> binary(). -md4(_Data) -> ?nif_stub. -md4_init() -> ?nif_stub. -md4_update(_Context, _Data) -> ?nif_stub. -md4_final(_Context) -> ?nif_stub. - -%% -%% RIPEMD160 -%% - --spec ripemd160(iodata()) -> binary(). --spec ripemd160_init() -> binary(). --spec ripemd160_update(binary(), iodata()) -> binary(). --spec ripemd160_final(binary()) -> binary(). - -ripemd160(_Data) -> ?nif_stub. -ripemd160_init() -> ?nif_stub. -ripemd160_update(_Context, _Data) -> ?nif_stub. -ripemd160_final(_Context) -> ?nif_stub. +md4(Data) -> + hash(md4, Data). +md4_init() -> + hash_init(md4). +md4_update(Context, Data) -> + hash_update(Context, Data). +md4_final(Context) -> + hash_final(Context). %% %% SHA @@ -805,196 +750,44 @@ ripemd160_final(_Context) -> ?nif_stub. -spec sha_update(binary(), iodata()) -> binary(). -spec sha_final(binary()) -> binary(). -sha(_Data) -> ?nif_stub. -sha_init() -> ?nif_stub. -sha_update(_Context, _Data) -> ?nif_stub. -sha_final(_Context) -> ?nif_stub. - -% -%% SHA224 -%% --spec sha224(iodata()) -> binary(). --spec sha224_init() -> binary(). --spec sha224_update(binary(), iodata()) -> binary(). --spec sha224_final(binary()) -> binary(). - -sha224(Data) -> - case sha224_nif(Data) of - notsup -> erlang:error(notsup); - Bin -> Bin - end. -sha224_init() -> - case sha224_init_nif() of - notsup -> erlang:error(notsup); - Bin -> Bin - end. -sha224_update(Context, Data) -> - case sha224_update_nif(Context, Data) of - notsup -> erlang:error(notsup); - Bin -> Bin - end. -sha224_final(Context) -> - case sha224_final_nif(Context) of - notsup -> erlang:error(notsup); - Bin -> Bin - end. - -sha224_nif(_Data) -> ?nif_stub. -sha224_init_nif() -> ?nif_stub. -sha224_update_nif(_Context, _Data) -> ?nif_stub. -sha224_final_nif(_Context) -> ?nif_stub. - -% -%% SHA256 -%% --spec sha256(iodata()) -> binary(). --spec sha256_init() -> binary(). --spec sha256_update(binary(), iodata()) -> binary(). --spec sha256_final(binary()) -> binary(). - -sha256(Data) -> - case sha256_nif(Data) of - notsup -> erlang:error(notsup); - Bin -> Bin - end. -sha256_init() -> - case sha256_init_nif() of - notsup -> erlang:error(notsup); - Bin -> Bin - end. -sha256_update(Context, Data) -> - case sha256_update_nif(Context, Data) of - notsup -> erlang:error(notsup); - Bin -> Bin - end. -sha256_final(Context) -> - case sha256_final_nif(Context) of - notsup -> erlang:error(notsup); - Bin -> Bin - end. - -sha256_nif(_Data) -> ?nif_stub. -sha256_init_nif() -> ?nif_stub. -sha256_update_nif(_Context, _Data) -> ?nif_stub. -sha256_final_nif(_Context) -> ?nif_stub. - -% -%% SHA384 -%% --spec sha384(iodata()) -> binary(). --spec sha384_init() -> binary(). --spec sha384_update(binary(), iodata()) -> binary(). --spec sha384_final(binary()) -> binary(). - -sha384(Data) -> - case sha384_nif(Data) of - notsup -> erlang:error(notsup); - Bin -> Bin - end. -sha384_init() -> - case sha384_init_nif() of - notsup -> erlang:error(notsup); - Bin -> Bin - end. -sha384_update(Context, Data) -> - case sha384_update_nif(Context, Data) of - notsup -> erlang:error(notsup); - Bin -> Bin - end. -sha384_final(Context) -> - case sha384_final_nif(Context) of - notsup -> erlang:error(notsup); - Bin -> Bin - end. - -sha384_nif(_Data) -> ?nif_stub. -sha384_init_nif() -> ?nif_stub. -sha384_update_nif(_Context, _Data) -> ?nif_stub. -sha384_final_nif(_Context) -> ?nif_stub. - -% -%% SHA512 -%% --spec sha512(iodata()) -> binary(). --spec sha512_init() -> binary(). --spec sha512_update(binary(), iodata()) -> binary(). --spec sha512_final(binary()) -> binary(). - -sha512(Data) -> - case sha512_nif(Data) of - notsup -> erlang:error(notsup); - Bin -> Bin - end. -sha512_init() -> - case sha512_init_nif() of - notsup -> erlang:error(notsup); - Bin -> Bin - end. -sha512_update(Context, Data) -> - case sha512_update_nif(Context, Data) of - notsup -> erlang:error(notsup); - Bin -> Bin - end. -sha512_final(Context) -> - case sha512_final_nif(Context) of - notsup -> erlang:error(notsup); - Bin -> Bin - end. - -sha512_nif(_Data) -> ?nif_stub. -sha512_init_nif() -> ?nif_stub. -sha512_update_nif(_Context, _Data) -> ?nif_stub. -sha512_final_nif(_Context) -> ?nif_stub. +sha(Data) -> + hash(sha, Data). +sha_init() -> + hash_init(sha). +sha_update(Context, Data) -> + hash_update(Context, Data). +sha_final(Context) -> + hash_final(Context). %% HMAC -------------------------------------------------------------------- -hmac(Type, Key, Data, MacSize, Size, MaxBytes, initial) when Size =< MaxBytes -> +hmac(Type, Key, Data, MacSize, Size, MaxBytes) when Size =< MaxBytes -> + notsup_to_error( case MacSize of - undefined -> - do_hmac(Type, Key, Data); - _ -> - do_hmac(Type, Key, Data, MacSize) - end; -hmac(Type, Key, Data, MacSize, _, MaxBytes, initial) -> - <<Increment:MaxBytes/binary, Rest/binary>> = Data, + undefined -> hmac_nif(Type, Key, Data); + _ -> hmac_nif(Type, Key, Data, MacSize) + end); +hmac(Type, Key, Data, MacSize, Size, MaxBytes) -> State0 = hmac_init(Type, Key), - State = hmac_update(State0, Increment), - hmac(State, Rest, MacSize, erlang:byte_size(Rest), max_bytes(), continue). -hmac(State0, Data, MacSize, Size, MaxBytes, continue) when Size =< MaxBytes -> - State = hmac_update(State0, Data), + State1 = hmac_update(State0, Data, Size, MaxBytes), case MacSize of - undefined -> - hmac_final(State); - _ -> - hmac_final_n(State, MacSize) - end; -hmac(State0, Data, MacSize, _Size, MaxBytes, continue) -> - <<Increment:MaxBytes/binary, Rest/binary>> = Data, - State = hmac_update(State0, Increment), - hmac(State, Rest, MacSize, erlang:byte_size(Rest), max_bytes(), continue). + undefined -> hmac_final(State1); + _ -> hmac_final_n(State1, MacSize) + end. hmac_update(State, Data, Size, MaxBytes) when Size =< MaxBytes -> - do_hmac_update(State, Data); + notsup_to_error(hmac_update_nif(State, Data)); hmac_update(State0, Data, _, MaxBytes) -> <<Increment:MaxBytes/binary, Rest/binary>> = Data, - State = do_hmac_update(State0, Increment), + State = notsup_to_error(hmac_update_nif(State0, Increment)), hmac_update(State, Rest, erlang:byte_size(Rest), MaxBytes). -do_hmac(md5, Key, Data) -> md5_mac(Key, Data); -do_hmac(sha, Key, Data) -> sha_mac(Key, Data); -do_hmac(sha224, Key, Data) -> sha224_mac(Key, Data); -do_hmac(sha256, Key, Data) -> sha256_mac(Key, Data); -do_hmac(sha384, Key, Data) -> sha384_mac(Key, Data); -do_hmac(sha512, Key, Data) -> sha512_mac(Key, Data). - -do_hmac(md5, Key, Data, Size) -> md5_mac_n(Key, Data, Size); -do_hmac(sha, Key, Data, Size) -> sha_mac_n(Key, Data, Size); -do_hmac(sha224, Key, Data, Size) -> sha224_mac(Key, Data, Size); -do_hmac(sha256, Key, Data, Size) -> sha256_mac(Key, Data, Size); -do_hmac(sha384, Key, Data, Size) -> sha384_mac(Key, Data, Size); -do_hmac(sha512, Key, Data, Size) -> sha512_mac(Key, Data, Size). - -do_hmac_update(_Context, _Data) -> ? nif_stub. +hmac_nif(_Type, _Key, _Data) -> ?nif_stub. +hmac_nif(_Type, _Key, _Data, _MacSize) -> ?nif_stub. +hmac_init_nif(_Type, _Key) -> ?nif_stub. +hmac_update_nif(_Context, _Data) -> ?nif_stub. +hmac_final_nif(_Context) -> ?nif_stub. +hmac_final_nif(_Context, _MacSize) -> ?nif_stub. %% %% MD5_MAC @@ -1002,97 +795,37 @@ do_hmac_update(_Context, _Data) -> ? nif_stub. -spec md5_mac(iodata(), iodata()) -> binary(). -spec md5_mac_96(iodata(), iodata()) -> binary(). -md5_mac(Key, Data) -> - md5_mac_n(Key,Data,16). +md5_mac(Key, Data) -> hmac(md5, Key, Data). -md5_mac_96(Key, Data) -> - md5_mac_n(Key,Data,12). +md5_mac_96(Key, Data) -> hmac(md5, Key, Data, 12). -md5_mac_n(_Key,_Data,_MacSz) -> ?nif_stub. - %% %% SHA_MAC %% -spec sha_mac(iodata(), iodata()) -> binary(). -spec sha_mac_96(iodata(), iodata()) -> binary(). -sha_mac(Key, Data) -> - sha_mac_n(Key,Data,20). - -sha_mac(Key, Data, Size) -> - sha_mac_n(Key, Data, Size). +sha_mac(Key, Data) -> hmac(sha, Key, Data). -sha_mac_96(Key, Data) -> - sha_mac_n(Key,Data,12). - -sha_mac_n(_Key,_Data,_MacSz) -> ?nif_stub. - -%% -%% SHA224_MAC -%% --spec sha224_mac(iodata(), iodata()) -> binary(). +sha_mac(Key, Data, Size) -> hmac(sha, Key, Data, Size). -sha224_mac(Key, Data) -> - sha224_mac(Key, Data, 224 div 8). +sha_mac_96(Key, Data) -> hmac(sha, Key, Data, 12). -sha224_mac(Key, Data, Size) -> - case sha224_mac_nif(Key, Data, Size) of - notsup -> erlang:error(notsup); - Bin -> Bin - end. - -sha224_mac_nif(_Key,_Data,_MacSz) -> ?nif_stub. - -%% -%% SHA256_MAC -%% --spec sha256_mac(iodata(), iodata()) -> binary(). - -sha256_mac(Key, Data) -> - sha256_mac(Key, Data, 256 div 8). - -sha256_mac(Key, Data, Size) -> - case sha256_mac_nif(Key, Data, Size) of - notsup -> erlang:error(notsup); - Bin -> Bin - end. - -sha256_mac_nif(_Key,_Data,_MacSz) -> ?nif_stub. - -%% -%% SHA384_MAC -%% --spec sha384_mac(iodata(), iodata()) -> binary(). - -sha384_mac(Key, Data) -> - sha384_mac(Key, Data, 384 div 8). - -sha384_mac(Key, Data, Size) -> - case sha384_mac_nif(Key, Data, Size) of - notsup -> erlang:error(notsup); - Bin -> Bin - end. - -sha384_mac_nif(_Key,_Data,_MacSz) -> ?nif_stub. - -%% -%% SHA512_MAC -%% --spec sha512_mac(iodata(), iodata()) -> binary(). - -sha512_mac(Key, Data) -> - sha512_mac(Key, Data, 512 div 8). +%% CIPHERS -------------------------------------------------------------------- -sha512_mac(Key, Data, MacSz) -> - case sha512_mac_nif(Key, Data, MacSz) of - notsup -> erlang:error(notsup); - Bin -> Bin +block_crypt_nif(_Type, _Key, _Ivec, _Text, _IsEncrypt) -> ?nif_stub. +block_crypt_nif(_Type, _Key, _Text, _IsEncrypt) -> ?nif_stub. + +check_des3_key(Key) -> + case lists:map(fun erlang:iolist_to_binary/1, Key) of + ValidKey = [B1, B2, B3] when byte_size(B1) =:= 8, + byte_size(B2) =:= 8, + byte_size(B3) =:= 8 -> + ValidKey; + _ -> + error(badarg) end. -sha512_mac_nif(_Key,_Data,_MacSz) -> ?nif_stub. - -%% CIPHERS -------------------------------------------------------------------- - %% %% DES - in electronic codebook mode (ECB) %% @@ -1100,10 +833,9 @@ sha512_mac_nif(_Key,_Data,_MacSz) -> ?nif_stub. -spec des_ecb_decrypt(iodata(), iodata()) -> binary(). des_ecb_encrypt(Key, Data) -> - des_ecb_crypt(Key, Data, true). + block_encrypt(des_ecb, Key, Data). des_ecb_decrypt(Key, Data) -> - des_ecb_crypt(Key, Data, false). -des_ecb_crypt(_Key, _Data, _IsEncrypt) -> ?nif_stub. + block_decrypt(des_ecb, Key, Data). %% %% DES3 - in cipher block chaining mode (CBC) @@ -1114,16 +846,14 @@ des_ecb_crypt(_Key, _Data, _IsEncrypt) -> ?nif_stub. binary(). des3_cbc_encrypt(Key1, Key2, Key3, IVec, Data) -> - des_ede3_cbc_crypt(Key1, Key2, Key3, IVec, Data, true). + block_encrypt(des3_cbc, [Key1, Key2, Key3], IVec, Data). des_ede3_cbc_encrypt(Key1, Key2, Key3, IVec, Data) -> - des_ede3_cbc_crypt(Key1, Key2, Key3, IVec, Data, true). + block_encrypt(des_ede3, [Key1, Key2, Key3], IVec, Data). des3_cbc_decrypt(Key1, Key2, Key3, IVec, Data) -> - des_ede3_cbc_crypt(Key1, Key2, Key3, IVec, Data, false). + block_decrypt(des3_cbc, [Key1, Key2, Key3], IVec, Data). des_ede3_cbc_decrypt(Key1, Key2, Key3, IVec, Data) -> - des_ede3_cbc_crypt(Key1, Key2, Key3, IVec, Data, false). - -des_ede3_cbc_crypt(_Key1, _Key2, _Key3, _IVec, _Data, _IsEncrypt) -> ?nif_stub. + block_decrypt(des_ede3, [Key1, Key2, Key3], IVec, Data). %% %% DES3 - in 8-bits cipher feedback mode (CFB) @@ -1134,18 +864,10 @@ des_ede3_cbc_crypt(_Key1, _Key2, _Key3, _IVec, _Data, _IsEncrypt) -> ?nif_stub. binary(). des3_cfb_encrypt(Key1, Key2, Key3, IVec, Data) -> - des_ede3_cfb_crypt(Key1, Key2, Key3, IVec, Data, true). + block_encrypt(des3_cbf, [Key1, Key2, Key3], IVec, Data). des3_cfb_decrypt(Key1, Key2, Key3, IVec, Data) -> - des_ede3_cfb_crypt(Key1, Key2, Key3, IVec, Data, false). - -des_ede3_cfb_crypt(Key1, Key2, Key3, IVec, Data, IsEncrypt) -> - case des_ede3_cfb_crypt_nif(Key1,Key2,Key3,IVec,Data,IsEncrypt) of - notsup -> erlang:error(notsup); - Bin -> Bin - end. - -des_ede3_cfb_crypt_nif(_Key1, _Key2, _Key3, _IVec, _Data, _IsEncrypt) -> ?nif_stub. + block_decrypt(des3_cbf, [Key1, Key2, Key3], IVec, Data). %% %% Blowfish @@ -1159,62 +881,38 @@ des_ede3_cfb_crypt_nif(_Key1, _Key2, _Key3, _IVec, _Data, _IsEncrypt) -> ?nif_st -spec blowfish_ofb64_encrypt(iodata(), binary(), iodata()) -> binary(). blowfish_ecb_encrypt(Key, Data) -> - bf_ecb_crypt(Key,Data, true). + block_encrypt(blowfish_ecb, Key, Data). blowfish_ecb_decrypt(Key, Data) -> - bf_ecb_crypt(Key,Data, false). - -bf_ecb_crypt(_Key,_Data,_IsEncrypt) -> ?nif_stub. + block_decrypt(blowfish_ecb, Key, Data). blowfish_cbc_encrypt(Key, IVec, Data) -> - bf_cbc_crypt(Key,IVec,Data,true). + block_encrypt(blowfish_cbc, Key, IVec, Data). blowfish_cbc_decrypt(Key, IVec, Data) -> - bf_cbc_crypt(Key,IVec,Data,false). - -bf_cbc_crypt(_Key,_IVec,_Data,_IsEncrypt) -> ?nif_stub. + block_decrypt(blowfish_cbc, Key, IVec, Data). blowfish_cfb64_encrypt(Key, IVec, Data) -> - bf_cfb64_crypt(Key, IVec, Data, true). + block_encrypt(blowfish_cfb64, Key, IVec, Data). blowfish_cfb64_decrypt(Key, IVec, Data) -> - bf_cfb64_crypt(Key, IVec, Data, false). - -bf_cfb64_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. - -blowfish_ofb64_decrypt(Key, Ivec, Data) -> - blowfish_ofb64_encrypt(Key, Ivec, Data). + block_decrypt(blowfish_cfb64, Key, IVec, Data). -blowfish_ofb64_encrypt(_Key, _IVec, _Data) -> ?nif_stub. +blowfish_ofb64_encrypt(Key, IVec, Data) -> + block_encrypt(blowfish_ofb64, Key, IVec, Data). %% -%% AES in cipher feedback mode (CFB) - 8 bit shift -%% --spec aes_cfb_8_encrypt(iodata(), binary(), iodata()) -> binary(). --spec aes_cfb_8_decrypt(iodata(), binary(), iodata()) -> binary(). - -aes_cfb_8_encrypt(Key, IVec, Data) -> - aes_cfb_8_crypt(Key, IVec, Data, true). - -aes_cfb_8_decrypt(Key, IVec, Data) -> - aes_cfb_8_crypt(Key, IVec, Data, false). - -aes_cfb_8_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. - -%% %% AES in cipher feedback mode (CFB) - 128 bit shift %% -spec aes_cfb_128_encrypt(iodata(), binary(), iodata()) -> binary(). -spec aes_cfb_128_decrypt(iodata(), binary(), iodata()) -> binary(). aes_cfb_128_encrypt(Key, IVec, Data) -> - aes_cfb_128_crypt(Key, IVec, Data, true). + block_encrypt(aes_cfb128, Key, IVec, Data). aes_cfb_128_decrypt(Key, IVec, Data) -> - aes_cfb_128_crypt(Key, IVec, Data, false). - -aes_cfb_128_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. + block_decrypt(aes_cfb128, Key, IVec, Data). %% %% AES - in Galois/Counter Mode (GCM) @@ -1235,12 +933,10 @@ chacha20_poly1305_decrypt(_Key, _Ivec, _AAD, _In, _Tag) -> ?nif_stub. -spec des_cbc_decrypt(iodata(), binary(), iodata()) -> binary(). des_cbc_encrypt(Key, IVec, Data) -> - des_cbc_crypt(Key, IVec, Data, true). + block_encrypt(des_cbc, Key, IVec, Data). des_cbc_decrypt(Key, IVec, Data) -> - des_cbc_crypt(Key, IVec, Data, false). - -des_cbc_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. + block_decrypt(des_cbc, Key, IVec, Data). %% %% dec_cbc_ivec(Data) -> binary() @@ -1250,11 +946,8 @@ des_cbc_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. %% -spec des_cbc_ivec(iodata()) -> binary(). -des_cbc_ivec(Data) when is_binary(Data) -> - {_, IVec} = split_binary(Data, size(Data) - 8), - IVec; -des_cbc_ivec(Data) when is_list(Data) -> - des_cbc_ivec(list_to_binary(Data)). +des_cbc_ivec(Data) -> + next_iv(des_cbc, Data). %% %% DES - in 8-bits cipher feedback mode (CFB) @@ -1263,12 +956,10 @@ des_cbc_ivec(Data) when is_list(Data) -> -spec des_cfb_decrypt(iodata(), binary(), iodata()) -> binary(). des_cfb_encrypt(Key, IVec, Data) -> - des_cfb_crypt(Key, IVec, Data, true). + block_encrypt(des_cfb, Key, IVec, Data). des_cfb_decrypt(Key, IVec, Data) -> - des_cfb_crypt(Key, IVec, Data, false). - -des_cfb_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. + block_decrypt(des_cfb, Key, IVec, Data). %% %% dec_cfb_ivec(IVec, Data) -> binary() @@ -1280,9 +971,7 @@ des_cfb_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. -spec des_cfb_ivec(iodata(), iodata()) -> binary(). des_cfb_ivec(IVec, Data) -> - IVecAndData = list_to_binary([IVec, Data]), - {_, NewIVec} = split_binary(IVecAndData, byte_size(IVecAndData) - 8), - NewIVec. + next_iv(des_cfb, Data, IVec). %% @@ -1298,18 +987,16 @@ des_cfb_ivec(IVec, Data) -> binary(). aes_cbc_128_encrypt(Key, IVec, Data) -> - aes_cbc_crypt(Key, IVec, Data, true). + block_encrypt(aes_cbc128, Key, IVec, Data). aes_cbc_128_decrypt(Key, IVec, Data) -> - aes_cbc_crypt(Key, IVec, Data, false). + block_decrypt(aes_cbc128, Key, IVec, Data). aes_cbc_256_encrypt(Key, IVec, Data) -> - aes_cbc_crypt(Key, IVec, Data, true). + block_encrypt(aes_cbc256, Key, IVec, Data). aes_cbc_256_decrypt(Key, IVec, Data) -> - aes_cbc_crypt(Key, IVec, Data, false). - -aes_cbc_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. + block_decrypt(aes_cbc256, Key, IVec, Data). %% %% aes_cbc_ivec(Data) -> binary() @@ -1318,47 +1005,15 @@ aes_cbc_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. %% aes_cbc_*_[encrypt|decrypt]. %% IVec size: 16 bytes %% -aes_cbc_ivec(Data) when is_binary(Data) -> - {_, IVec} = split_binary(Data, size(Data) - 16), - IVec; -aes_cbc_ivec(Data) when is_list(Data) -> - aes_cbc_ivec(list_to_binary(Data)). - +aes_cbc_ivec(Data) -> + next_iv(aes_cbc, Data). %% %% AES - with 256 bit key in infinite garble extension mode (IGE) %% --spec aes_ige_256_decrypt(iodata(), binary(), iodata()) -> - binary(). - -aes_ige_256_encrypt(Key, IVec, Data) -> - aes_ige_crypt(Key, IVec, Data, true). - -aes_ige_256_decrypt(Key, IVec, Data) -> - aes_ige_crypt(Key, IVec, Data, false). - -aes_ige_crypt(Key, IVec, Data, IsEncrypt) -> - case aes_ige_crypt_nif(Key,IVec,Data,IsEncrypt) of - notsup -> erlang:error(notsup); - Bin -> Bin - end. - aes_ige_crypt_nif(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. -%% -%% aes_ige_ivec(Data) -> binary() -%% -%% Returns the IVec to be used in the next iteration of -%% aes_ige_*_[encrypt|decrypt]. -%% IVec size: 32 bytes -%% -aes_ige_ivec(Data) when is_binary(Data) -> - {_, IVec} = split_binary(Data, size(Data) - 32), - IVec; -aes_ige_ivec(Data) when is_list(Data) -> - aes_ige_ivec(list_to_binary(Data)). - %% Stream ciphers -------------------------------------------------------------------- @@ -1397,22 +1052,11 @@ do_stream_decrypt({rc4, State0}, Data) -> aes_ctr_encrypt(_Key, _IVec, _Data) -> ?nif_stub. aes_ctr_decrypt(_Key, _IVec, _Cipher) -> ?nif_stub. -%% -%% AES - in electronic codebook mode (ECB) -%% -aes_ecb_encrypt(Key, Data) -> - aes_ecb_crypt(Key, Data, true). - -aes_ecb_decrypt(Key, Data) -> - aes_ecb_crypt(Key, Data, false). - -aes_ecb_crypt(_Key, __Data, _IsEncrypt) -> ?nif_stub. - %% %% AES - in counter mode (CTR) with state maintained for multi-call streaming %% --type ctr_state() :: { iodata(), binary(), binary(), integer() }. +-type ctr_state() :: { iodata(), binary(), binary(), integer() } | binary(). -spec aes_ctr_stream_init(iodata(), binary()) -> ctr_state(). -spec aes_ctr_stream_encrypt(ctr_state(), binary()) -> @@ -1420,10 +1064,9 @@ aes_ecb_crypt(_Key, __Data, _IsEncrypt) -> ?nif_stub. -spec aes_ctr_stream_decrypt(ctr_state(), binary()) -> { ctr_state(), binary() }. -aes_ctr_stream_init(Key, IVec) -> - {Key, IVec, << 0:128 >>, 0}. -aes_ctr_stream_encrypt({_Key, _IVec, _ECount, _Num}=_State, _Data) -> ?nif_stub. -aes_ctr_stream_decrypt({_Key, _IVec, _ECount, _Num}=_State, _Cipher) -> ?nif_stub. +aes_ctr_stream_init(_Key, _IVec) -> ?nif_stub. +aes_ctr_stream_encrypt(_State, _Data) -> ?nif_stub. +aes_ctr_stream_decrypt(_State, _Cipher) -> ?nif_stub. %% %% RC4 - symmetric stream cipher @@ -1438,21 +1081,19 @@ rc4_encrypt_with_state(_State, _Data) -> ?nif_stub. %% RC2 block cipher rc2_cbc_encrypt(Key, IVec, Data) -> - rc2_cbc_crypt(Key,IVec,Data,true). + block_encrypt(rc2_cbc, Key, IVec, Data). rc2_cbc_decrypt(Key, IVec, Data) -> - rc2_cbc_crypt(Key,IVec,Data,false). - -rc2_cbc_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. + block_decrypt(rc2_cbc, Key, IVec, Data). %% %% RC2 - 40 bits block cipher - Backwards compatibility not documented. %% rc2_40_cbc_encrypt(Key, IVec, Data) when erlang:byte_size(Key) == 5 -> - rc2_cbc_crypt(Key,IVec,Data,true). + block_encrypt(rc2_cbc, Key, IVec, Data). rc2_40_cbc_decrypt(Key, IVec, Data) when erlang:byte_size(Key) == 5 -> - rc2_cbc_crypt(Key,IVec,Data,false). + block_decrypt(rc2_cbc, Key, IVec, Data). %% Secure remote password ------------------------------------------------------------------- @@ -1470,16 +1111,18 @@ host_srp_gen_key(Private, Verifier, Generator, Prime, Version) -> case srp_value_B_nif(Multiplier, Verifier, Generator, Private, Prime) of error -> error; + notsup -> + erlang:error(notsup); Public -> {Public, Private} end. srp_multiplier('6a', Generator, Prime) -> %% k = SHA1(N | PAD(g)) from http://srp.stanford.edu/design.html - C0 = sha_init(), - C1 = sha_update(C0, Prime), - C2 = sha_update(C1, srp_pad_to(erlang:byte_size(Prime), Generator)), - sha_final(C2); + C0 = hash_init(sha), + C1 = hash_update(C0, Prime), + C2 = hash_update(C1, srp_pad_to(erlang:byte_size(Prime), Generator)), + hash_final(C2); srp_multiplier('6', _, _) -> <<3/integer>>; srp_multiplier('3', _, _) -> @@ -1488,10 +1131,10 @@ srp_multiplier('3', _, _) -> srp_scrambler(Version, UserPublic, HostPublic, Prime) when Version == '6'; Version == '6a'-> %% SHA1(PAD(A) | PAD(B)) from http://srp.stanford.edu/design.html PadLength = erlang:byte_size(Prime), - C0 = sha_init(), - C1 = sha_update(C0, srp_pad_to(PadLength, UserPublic)), - C2 = sha_update(C1, srp_pad_to(PadLength, HostPublic)), - sha_final(C2); + C0 = hash_init(sha), + C1 = hash_update(C0, srp_pad_to(PadLength, UserPublic)), + C2 = hash_update(C1, srp_pad_to(PadLength, HostPublic)), + hash_final(C2); srp_scrambler('3', _, HostPublic, _Prime) -> %% The parameter u is a 32-bit unsigned integer which takes its value %% from the first 32 bits of the SHA1 hash of B, MSB first. @@ -1515,13 +1158,13 @@ srp_value_B_nif(_Multiplier, _Verifier, _Generator, _Exponent, _Prime) -> ?nif_s %% Digital signatures -------------------------------------------------------------------- -rsa_sign_nif(_Type,_Data,_Key) -> ?nif_stub. -dss_sign_nif(_Type,_Data,_Key) -> ?nif_stub. -ecdsa_sign_nif(_Type, _DataOrDigest, _Curve, _Key) -> ?nif_stub. +rsa_sign_nif(_Type,_Digest,_Key) -> ?nif_stub. +dss_sign_nif(_Type,_Digest,_Key) -> ?nif_stub. +ecdsa_sign_nif(_Type, _Digest, _Curve, _Key) -> ?nif_stub. -dss_verify_nif(_Type, _Data, _Signature, _Key) -> ?nif_stub. -rsa_verify_nif(_Type, _Data, _Signature, _Key) -> ?nif_stub. -ecdsa_verify_nif(_Type, _DataOrDigest, _Signature, _Curve, _Key) -> ?nif_stub. +dss_verify_nif(_Type, _Digest, _Signature, _Key) -> ?nif_stub. +rsa_verify_nif(_Type, _Digest, _Signature, _Key) -> ?nif_stub. +ecdsa_verify_nif(_Type, _Digest, _Signature, _Curve, _Key) -> ?nif_stub. %% Public Keys -------------------------------------------------------------------- %% DH Diffie-Hellman functions diff --git a/lib/crypto/test/Makefile b/lib/crypto/test/Makefile index 07e5c1b754..928a1b1d73 100644 --- a/lib/crypto/test/Makefile +++ b/lib/crypto/test/Makefile @@ -28,7 +28,7 @@ RELSYSDIR = $(RELEASE_PATH)/crypto_test # FLAGS # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +ERL_COMPILE_FLAGS += EBIN = . MAKE_EMAKE = $(wildcard $(ERL_TOP)/make/make_emakefile) diff --git a/lib/crypto/test/blowfish_SUITE.erl b/lib/crypto/test/blowfish_SUITE.erl index b0d6954820..19f60450e9 100644 --- a/lib/crypto/test/blowfish_SUITE.erl +++ b/lib/crypto/test/blowfish_SUITE.erl @@ -24,8 +24,7 @@ %% Note: This directive should only be used in test suites. -compile(export_all). --include_lib("test_server/include/test_server.hrl"). --include("test_server_line.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(TIMEOUT, 120000). % 2 min diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index e84f5e1075..f34d27649a 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -66,6 +66,7 @@ all() -> {group, aes_ctr}, {group, aes_gcm}, {group, chacha20_poly1305}, + {group, aes_cbc}, mod_pow, exor, rand_uniform @@ -107,7 +108,8 @@ groups() -> {rc4, [], [stream]}, {aes_ctr, [], [stream]}, {aes_gcm, [], [aead]}, - {chacha20_poly1305, [], [aead]} + {chacha20_poly1305, [], [aead]}, + {aes_cbc, [], [block]} ]. %%------------------------------------------------------------------- @@ -118,10 +120,10 @@ init_per_suite(Config) -> _ -> Config catch error:low_entropy -> - %% Make sure we are on OSE, otherwise we want to crash - {ose,_} = os:type(), + %% We are testing on an OS with low entropy in its random + %% seed. So we have to seed it with a binary to get started. - %% This is NOT how you want to seed this, it is just here + %% This is NOT how you want to do seeding, it is just here %% to make the tests pass. Check your OS manual for how you %% really want to seed. {H,M,L} = erlang:now(), @@ -363,6 +365,21 @@ block_cipher({Type, Key, IV, PlainText}) -> ok; Other -> ct:fail({{crypto, block_decrypt, [Type, Key, IV, CipherText]}, {expected, Plain}, {got, Other}}) + end; + +block_cipher({Type, Key, IV, PlainText, CipherText}) -> + Plain = iolist_to_binary(PlainText), + case crypto:block_encrypt(Type, Key, IV, Plain) of + CipherText -> + ok; + Other0 -> + ct:fail({{crypto, block_encrypt, [Type, Key, IV, Plain]}, {expected, CipherText}, {got, Other0}}) + end, + case crypto:block_decrypt(Type, Key, IV, CipherText) of + Plain -> + ok; + Other1 -> + ct:fail({{crypto, block_decrypt, [Type, Key, IV, CipherText]}, {expected, Plain}, {got, Other1}}) end. block_cipher_increment({Type, Key, IV, PlainTexts}) when Type == des_cbc; @@ -370,7 +387,11 @@ block_cipher_increment({Type, Key, IV, PlainTexts}) when Type == des_cbc; Type == aes_cbc; Type == des_cbf -> - block_cipher_increment(Type, Key, IV, IV, PlainTexts, iolist_to_binary(PlainTexts), []); + block_cipher_increment(Type, Key, IV, IV, PlainTexts, iolist_to_binary(PlainTexts), []); +block_cipher_increment({Type, Key, IV, PlainTexts, _CipherText}) when Type == aes_cbc -> + Plain = iolist_to_binary(PlainTexts), + Blocks = [iolistify(Block) || << Block:128/bitstring >> <= Plain], + block_cipher_increment(Type, Key, IV, IV, Blocks, Plain, []); block_cipher_increment({_Type, _, _, _}) -> ok; block_cipher_increment({_,_,_}) -> @@ -552,7 +573,9 @@ do_block_iolistify({des_ede3 = Type, Key, IV, PlainText}) -> do_block_iolistify({Type, Key, PlainText}) -> {Type, iolistify(Key), iolistify(PlainText)}; do_block_iolistify({Type, Key, IV, PlainText}) -> - {Type, iolistify(Key), IV, iolistify(PlainText)}. + {Type, iolistify(Key), IV, iolistify(PlainText)}; +do_block_iolistify({Type, Key, IV, PlainText, CipherText}) -> + {Type, iolistify(Key), IV, iolistify(PlainText), CipherText}. iolistify(<<"Test With Truncation">>)-> %% Do not iolistify as it spoils this special case @@ -803,6 +826,9 @@ group_config(aes_gcm, Config) -> group_config(chacha20_poly1305, Config) -> AEAD = chacha20_poly1305(), [{aead, AEAD} | Config]; +group_config(aes_cbc, Config) -> + Block = aes_cbc(), + [{block, Block} | Config]; group_config(_, Config) -> Config. @@ -1166,6 +1192,50 @@ rc2_cbc() -> <<72,91,135,182,25,42,35,210>>, <<36,245,206,158,168,230,58,69,148,137,32,192,250,41,237,181,181,251, 192,2,175,135,177,171,57,30,111,117,159,149,15,28,88,158,28,81,28,115, 85,219,241,82,117,222,91,85,73,117,164,25,182,52,191,64,123,57,26,19, 211,27,253,31,194,219,231,104,247,240,172,130,119,21,225,154,101,247, 32,216,42,216,133,169,78,22,97,27,227,26,196,224,172,168,17,9,148,55, 203,91,252,40,61,226,236,221,215,160,78,63,13,181,68,57,196,241,185, 207, 116,129,152,237,60,139,247,153,27,146,161,246,222,98,185,222,152, 187,135, 236,86,34,7,110,91,230,173,34,160,242,202,222,121,127,181,140, 101,203,195, 190,88,250,86,147,127,87,72,126,171,16,71,47,110,248,88, 14,29,143,161,152, 129,236,148,22,152,186,208,119,70,8,174,193,203,100, 193,203,200,117,102,242, 134,142,96,125,135,200,217,190,76,117,50,70, 209,186,101,241,200,91,40,193,54, 90,195,38,47,59,197,38,234,86,223,16, 51,253,204,129,20,171,66,21,241,26,135,216, 196,114,110,91,15,53,40, 164,201,136,113,95,247,51,181,208,241,68,168,98,151,36, 155,72,24,57, 42,191,14,125,204,10,167,214,233,138,115,125,234,121,134,227,26,247, 77,200,117,110,117,111,168,156,206,67,159,149,189,173,150,193,91,199, 216,153,22, 189,137,185,89,160,13,131,132,58,109,28,110,246,252,251,14, 232,91,38,52,29,101,188,69,123,50,0,130,178,93,73,239,118,7,77,35,59, 253,10,159,45,86,142,37,78,232,48>> }]. + +%% AES CBC test vectors from http://csrc.nist.gov/publications/nistpubs/800-38a/sp800-38a.pdf +aes_cbc() -> + [ + %% F.2.1 CBC-AES128.Encrypt, F.2.2 CBC-AES128.Decrypt + {aes_cbc, + hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), %% Key + hexstr2bin("000102030405060708090a0b0c0d0e0f"), %% IV + hexstr2bin("6bc1bee22e409f96e93d7e117393172a" %% PlainText + "ae2d8a571e03ac9c9eb76fac45af8e51" + "30c81c46a35ce411e5fbc1191a0a52ef" + "f69f2445df4f9b17ad2b417be66c3710"), + hexstr2bin("7649abac8119b246cee98e9b12e9197d" %% CipherText + "5086cb9b507219ee95db113a917678b2" + "73bed6b8e3c1743b7116e69e22229516" + "3ff1caa1681fac09120eca307586e1a7")}, + %% F.2.3 CBC-AES192.Encrypt, F.2.4 CBC-AES192.Decrypt + {aes_cbc, + hexstr2bin("8e73b0f7da0e6452c810f32b809079e5" %% Key + "62f8ead2522c6b7b"), + hexstr2bin("000102030405060708090a0b0c0d0e0f"), %% IV + hexstr2bin("6bc1bee22e409f96e93d7e117393172a" %% PlainText + "ae2d8a571e03ac9c9eb76fac45af8e51" + "30c81c46a35ce411e5fbc1191a0a52ef" + "f69f2445df4f9b17ad2b417be66c3710"), + hexstr2bin("4f021db243bc633d7178183a9fa071e8" %% CipherText + "b4d9ada9ad7dedf4e5e738763f69145a" + "571b242012fb7ae07fa9baac3df102e0" + "08b0e27988598881d920a9e64f5615cd")}, + %% F.2.5 CBC-AES256.Encrypt, F.2.6 CBC-AES256.Decrypt + {aes_cbc, + hexstr2bin("603deb1015ca71be2b73aef0857d7781" %% Key + "1f352c073b6108d72d9810a30914dff4"), + hexstr2bin("000102030405060708090a0b0c0d0e0f"), %% IV + hexstr2bin("6bc1bee22e409f96e93d7e117393172a" %% PlainText + "ae2d8a571e03ac9c9eb76fac45af8e51" + "30c81c46a35ce411e5fbc1191a0a52ef" + "f69f2445df4f9b17ad2b417be66c3710"), + hexstr2bin("f58c4c04d6e5f1ba779eabfb5f7bfbd6" %% CipherText + "9cfc4e967edb808d679f777bc6702c7d" + "39f23369a9d9bacfa530e26304231461" + "b2eb05e2c39be9fcda6c19078c6a9d1b")} + ]. + aes_cbc128() -> [{aes_cbc128, hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), @@ -1301,7 +1371,31 @@ aes_ecb() -> <<"0000000000000000">>}, {aes_ecb, <<"FEDCBA9876543210">>, - <<"FFFFFFFFFFFFFFFF">>} + <<"FFFFFFFFFFFFFFFF">>}, + %% AES ECB test vectors from http://csrc.nist.gov/publications/nistpubs/800-38a/sp800-38a.pdf + %% F.1.1 ECB-AES128.Encrypt, F.1.2 ECB-AES128.Decrypt + {aes_ecb, + hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), + hexstr2bin("6bc1bee22e409f96e93d7e117393172a" + "ae2d8a571e03ac9c9eb76fac45af8e51" + "30c81c46a35ce411e5fbc1191a0a52ef" + "f69f2445df4f9b17ad2b417be66c3710")}, + %% F.1.3 ECB-AES192.Encrypt, F.1.4 ECB-AES192.Decrypt + {aes_ecb, + hexstr2bin("8e73b0f7da0e6452c810f32b809079e5" + "62f8ead2522c6b7b"), + hexstr2bin("6bc1bee22e409f96e93d7e117393172a" + "ae2d8a571e03ac9c9eb76fac45af8e51" + "30c81c46a35ce411e5fbc1191a0a52ef" + "f69f2445df4f9b17ad2b417be66c3710")}, + %% F.1.5 ECB-AES256.Encrypt, F.1.6 ECB-AES256.Decrypt + {aes_ecb, + hexstr2bin("603deb1015ca71be2b73aef0857d7781" + "1f352c073b6108d72d9810a30914dff4"), + hexstr2bin("6bc1bee22e409f96e93d7e117393172a" + "ae2d8a571e03ac9c9eb76fac45af8e51" + "30c81c46a35ce411e5fbc1191a0a52ef" + "f69f2445df4f9b17ad2b417be66c3710")} ]. aes_ige256() -> @@ -1885,7 +1979,7 @@ dss_params() -> 18320614775012672475365915366944922415598782131828709277168615511695849821411624805195787607930033958243224786899641459701930253094446221381818858674389863050420226114787005820357372837321561754462061849169568607689530279303056075793886577588606958623645901271866346406773590024901668622321064384483571751669]. ec_key_named() -> - Curve = secp112r2, + Curve = hd(crypto:ec_curves()), {D2_pub, D2_priv} = crypto:generate_key(ecdh, Curve), {[D2_priv, Curve], [D2_pub, Curve]}. @@ -2054,88 +2148,94 @@ srp(ClientPrivate, Generator, Prime, Version, Verifier, ServerPublic, ServerPriv SessionKey}. ecdh() -> %% http://csrc.nist.gov/groups/STM/cavp/ - [{ecdh, hexstr2point("42ea6dd9969dd2a61fea1aac7f8e98edcc896c6e55857cc0", "dfbe5d7c61fac88b11811bde328e8a0d12bf01a9d204b523"), - hexstr2bin("f17d3fea367b74d340851ca4270dcb24c271f445bed9d527"), - secp192r1, - hexstr2bin("803d8ab2e5b6e6fca715737c3a82f7ce3c783124f6d51cd0")}, - {ecdh, hexstr2point("deb5712fa027ac8d2f22c455ccb73a91e17b6512b5e030e7", "7e2690a02cc9b28708431a29fb54b87b1f0c14e011ac2125"), - hexstr2bin("56e853349d96fe4c442448dacb7cf92bb7a95dcf574a9bd5"), - secp192r1, - hexstr2bin("c208847568b98835d7312cef1f97f7aa298283152313c29d")}, - {ecdh, hexstr2point("af33cd0629bc7e996320a3f40368f74de8704fa37b8fab69abaae280", "882092ccbba7930f419a8a4f9bb16978bbc3838729992559a6f2e2d7"), - hexstr2bin("8346a60fc6f293ca5a0d2af68ba71d1dd389e5e40837942df3e43cbd"), - secp224r1, - hexstr2bin("7d96f9a3bd3c05cf5cc37feb8b9d5209d5c2597464dec3e9983743e8")}, - {ecdh, hexstr2point("13bfcd4f8e9442393cab8fb46b9f0566c226b22b37076976f0617a46", "eeb2427529b288c63c2f8963c1e473df2fca6caa90d52e2f8db56dd4"), - hexstr2bin("043cb216f4b72cdf7629d63720a54aee0c99eb32d74477dac0c2f73d"), - secp224r1, - hexstr2bin("ee93ce06b89ff72009e858c68eb708e7bc79ee0300f73bed69bbca09")}, - {ecdh, hexstr2point("700c48f77f56584c5cc632ca65640db91b6bacce3a4df6b42ce7cc838833d287", "db71e509e3fd9b060ddb20ba5c51dcc5948d46fbf640dfe0441782cab85fa4ac"), - hexstr2bin("7d7dc5f71eb29ddaf80d6214632eeae03d9058af1fb6d22ed80badb62bc1a534"), - secp256r1, - hexstr2bin("46fc62106420ff012e54a434fbdd2d25ccc5852060561e68040dd7778997bd7b")}, - {ecdh, hexstr2point("809f04289c64348c01515eb03d5ce7ac1a8cb9498f5caa50197e58d43a86a7ae", "b29d84e811197f25eba8f5194092cb6ff440e26d4421011372461f579271cda3"), - hexstr2bin("38f65d6dce47676044d58ce5139582d568f64bb16098d179dbab07741dd5caf5"), - secp256r1, - hexstr2bin("057d636096cb80b67a8c038c890e887d1adfa4195e9b3ce241c8a778c59cda67")}, - {ecdh, hexstr2point("a7c76b970c3b5fe8b05d2838ae04ab47697b9eaf52e764592efda27fe7513272734466b400091adbf2d68c58e0c50066", "ac68f19f2e1cb879aed43a9969b91a0839c4c38a49749b661efedf243451915ed0905a32b060992b468c64766fc8437a"), - hexstr2bin("3cc3122a68f0d95027ad38c067916ba0eb8c38894d22e1b15618b6818a661774ad463b205da88cf699ab4d43c9cf98a1"), - secp384r1, - hexstr2bin("5f9d29dc5e31a163060356213669c8ce132e22f57c9a04f40ba7fcead493b457e5621e766c40a2e3d4d6a04b25e533f1")}, - {ecdh, hexstr2point("30f43fcf2b6b00de53f624f1543090681839717d53c7c955d1d69efaf0349b7363acb447240101cbb3af6641ce4b88e0", "25e46c0c54f0162a77efcc27b6ea792002ae2ba82714299c860857a68153ab62e525ec0530d81b5aa15897981e858757"), - hexstr2bin("92860c21bde06165f8e900c687f8ef0a05d14f290b3f07d8b3a8cc6404366e5d5119cd6d03fb12dc58e89f13df9cd783"), - secp384r1, - hexstr2bin("a23742a2c267d7425fda94b93f93bbcc24791ac51cd8fd501a238d40812f4cbfc59aac9520d758cf789c76300c69d2ff")}, - {ecdh, hexstr2point("00685a48e86c79f0f0875f7bc18d25eb5fc8c0b07e5da4f4370f3a9490340854334b1e1b87fa395464c60626124a4e70d0f785601d37c09870ebf176666877a2046d", "01ba52c56fc8776d9e8f5db4f0cc27636d0b741bbe05400697942e80b739884a83bde99e0f6716939e632bc8986fa18dccd443a348b6c3e522497955a4f3c302f676"), - hexstr2bin("017eecc07ab4b329068fba65e56a1f8890aa935e57134ae0ffcce802735151f4eac6564f6ee9974c5e6887a1fefee5743ae2241bfeb95d5ce31ddcb6f9edb4d6fc47"), - secp521r1, - hexstr2bin("005fc70477c3e63bc3954bd0df3ea0d1f41ee21746ed95fc5e1fdf90930d5e136672d72cc770742d1711c3c3a4c334a0ad9759436a4d3c5bf6e74b9578fac148c831")}, - {ecdh, hexstr2point("01df277c152108349bc34d539ee0cf06b24f5d3500677b4445453ccc21409453aafb8a72a0be9ebe54d12270aa51b3ab7f316aa5e74a951c5e53f74cd95fc29aee7a", "013d52f33a9f3c14384d1587fa8abe7aed74bc33749ad9c570b471776422c7d4505d9b0a96b3bfac041e4c6a6990ae7f700e5b4a6640229112deafa0cd8bb0d089b0"), - hexstr2bin("00816f19c1fb10ef94d4a1d81c156ec3d1de08b66761f03f06ee4bb9dcebbbfe1eaa1ed49a6a990838d8ed318c14d74cc872f95d05d07ad50f621ceb620cd905cfb8"), - secp521r1, - hexstr2bin("000b3920ac830ade812c8f96805da2236e002acbbf13596a9ab254d44d0e91b6255ebf1229f366fb5a05c5884ef46032c26d42189273ca4efa4c3db6bd12a6853759")}, - - %% RFC-6954, Appendix A - {ecdh, hexstr2point("A9C21A569759DA95E0387041184261440327AFE33141CA04B82DC92E", - "98A0F75FBBF61D8E58AE5511B2BCDBE8E549B31E37069A2825F590C1"), - hexstr2bin("6060552303899E2140715816C45B57D9B42204FB6A5BF5BEAC10DB00"), - brainpoolP224r1, - hexstr2bin("1A4BFE705445120C8E3E026699054104510D119757B74D5FE2462C66")}, - {ecdh, hexstr2point("034A56C550FF88056144E6DD56070F54B0135976B5BF77827313F36B", - "75165AD99347DC86CAAB1CBB579E198EAF88DC35F927B358AA683681"), - hexstr2bin("39F155483CEE191FBECFE9C81D8AB1A03CDA6790E7184ACE44BCA161"), - brainpoolP224r1, - hexstr2bin("1A4BFE705445120C8E3E026699054104510D119757B74D5FE2462C66")}, - {ecdh, hexstr2point("44106E913F92BC02A1705D9953A8414DB95E1AAA49E81D9E85F929A8E3100BE5", - "8AB4846F11CACCB73CE49CBDD120F5A900A69FD32C272223F789EF10EB089BDC"), - hexstr2bin("55E40BC41E37E3E2AD25C3C6654511FFA8474A91A0032087593852D3E7D76BD3"), - brainpoolP256r1, - hexstr2bin("89AFC39D41D3B327814B80940B042590F96556EC91E6AE7939BCE31F3A18BF2B")}, - {ecdh, hexstr2point("8D2D688C6CF93E1160AD04CC4429117DC2C41825E1E9FCA0ADDD34E6F1B39F7B", - "990C57520812BE512641E47034832106BC7D3E8DD0E4C7F1136D7006547CEC6A"), - hexstr2bin("81DB1EE100150FF2EA338D708271BE38300CB54241D79950F77B063039804F1D"), - brainpoolP256r1, - hexstr2bin("89AFC39D41D3B327814B80940B042590F96556EC91E6AE7939BCE31F3A18BF2B")}, - {ecdh, hexstr2point("68B665DD91C195800650CDD363C625F4E742E8134667B767B1B476793588F885AB698C852D4A6E77A252D6380FCAF068", - "55BC91A39C9EC01DEE36017B7D673A931236D2F1F5C83942D049E3FA20607493E0D038FF2FD30C2AB67D15C85F7FAA59"), - hexstr2bin("032640BC6003C59260F7250C3DB58CE647F98E1260ACCE4ACDA3DD869F74E01F8BA5E0324309DB6A9831497ABAC96670"), - brainpoolP384r1, - hexstr2bin("0BD9D3A7EA0B3D519D09D8E48D0785FB744A6B355E6304BC51C229FBBCE239BBADF6403715C35D4FB2A5444F575D4F42")}, - {ecdh, hexstr2point("4D44326F269A597A5B58BBA565DA5556ED7FD9A8A9EB76C25F46DB69D19DC8CE6AD18E404B15738B2086DF37E71D1EB4", - "62D692136DE56CBE93BF5FA3188EF58BC8A3A0EC6C1E151A21038A42E9185329B5B275903D192F8D4E1F32FE9CC78C48"), - hexstr2bin("1E20F5E048A5886F1F157C74E91BDE2B98C8B52D58E5003D57053FC4B0BD65D6F15EB5D1EE1610DF870795143627D042"), - brainpoolP384r1, - hexstr2bin("0BD9D3A7EA0B3D519D09D8E48D0785FB744A6B355E6304BC51C229FBBCE239BBADF6403715C35D4FB2A5444F575D4F42")}, - {ecdh, hexstr2point("0A420517E406AAC0ACDCE90FCD71487718D3B953EFD7FBEC5F7F27E28C6149999397E91E029E06457DB2D3E640668B392C2A7E737A7F0BF04436D11640FD09FD", - "72E6882E8DB28AAD36237CD25D580DB23783961C8DC52DFA2EC138AD472A0FCEF3887CF62B623B2A87DE5C588301EA3E5FC269B373B60724F5E82A6AD147FDE7"), - hexstr2bin("230E18E1BCC88A362FA54E4EA3902009292F7F8033624FD471B5D8ACE49D12CFABBC19963DAB8E2F1EBA00BFFB29E4D72D13F2224562F405CB80503666B25429"), - brainpoolP512r1, - hexstr2bin("A7927098655F1F9976FA50A9D566865DC530331846381C87256BAF3226244B76D36403C024D7BBF0AA0803EAFF405D3D24F11A9B5C0BEF679FE1454B21C4CD1F")}, - {ecdh, hexstr2point("9D45F66DE5D67E2E6DB6E93A59CE0BB48106097FF78A081DE781CDB31FCE8CCBAAEA8DD4320C4119F1E9CD437A2EAB3731FA9668AB268D871DEDA55A5473199F", - "2FDC313095BCDD5FB3A91636F07A959C8E86B5636A1E930E8396049CB481961D365CC11453A06C719835475B12CB52FC3C383BCE35E27EF194512B71876285FA"), - hexstr2bin("16302FF0DBBB5A8D733DAB7141C1B45ACBC8715939677F6A56850A38BD87BD59B09E80279609FF333EB9D4C061231FB26F92EEB04982A5F1D1764CAD57665422"), - brainpoolP512r1, - hexstr2bin("A7927098655F1F9976FA50A9D566865DC530331846381C87256BAF3226244B76D36403C024D7BBF0AA0803EAFF405D3D24F11A9B5C0BEF679FE1454B21C4CD1F")}]. + Curves = crypto:ec_curves(), + TestCases = + [{ecdh, hexstr2point("42ea6dd9969dd2a61fea1aac7f8e98edcc896c6e55857cc0", "dfbe5d7c61fac88b11811bde328e8a0d12bf01a9d204b523"), + hexstr2bin("f17d3fea367b74d340851ca4270dcb24c271f445bed9d527"), + secp192r1, + hexstr2bin("803d8ab2e5b6e6fca715737c3a82f7ce3c783124f6d51cd0")}, + {ecdh, hexstr2point("deb5712fa027ac8d2f22c455ccb73a91e17b6512b5e030e7", "7e2690a02cc9b28708431a29fb54b87b1f0c14e011ac2125"), + hexstr2bin("56e853349d96fe4c442448dacb7cf92bb7a95dcf574a9bd5"), + secp192r1, + hexstr2bin("c208847568b98835d7312cef1f97f7aa298283152313c29d")}, + {ecdh, hexstr2point("af33cd0629bc7e996320a3f40368f74de8704fa37b8fab69abaae280", "882092ccbba7930f419a8a4f9bb16978bbc3838729992559a6f2e2d7"), + hexstr2bin("8346a60fc6f293ca5a0d2af68ba71d1dd389e5e40837942df3e43cbd"), + secp224r1, + hexstr2bin("7d96f9a3bd3c05cf5cc37feb8b9d5209d5c2597464dec3e9983743e8")}, + {ecdh, hexstr2point("13bfcd4f8e9442393cab8fb46b9f0566c226b22b37076976f0617a46", "eeb2427529b288c63c2f8963c1e473df2fca6caa90d52e2f8db56dd4"), + hexstr2bin("043cb216f4b72cdf7629d63720a54aee0c99eb32d74477dac0c2f73d"), + secp224r1, + hexstr2bin("ee93ce06b89ff72009e858c68eb708e7bc79ee0300f73bed69bbca09")}, + {ecdh, hexstr2point("700c48f77f56584c5cc632ca65640db91b6bacce3a4df6b42ce7cc838833d287", "db71e509e3fd9b060ddb20ba5c51dcc5948d46fbf640dfe0441782cab85fa4ac"), + hexstr2bin("7d7dc5f71eb29ddaf80d6214632eeae03d9058af1fb6d22ed80badb62bc1a534"), + secp256r1, + hexstr2bin("46fc62106420ff012e54a434fbdd2d25ccc5852060561e68040dd7778997bd7b")}, + {ecdh, hexstr2point("809f04289c64348c01515eb03d5ce7ac1a8cb9498f5caa50197e58d43a86a7ae", "b29d84e811197f25eba8f5194092cb6ff440e26d4421011372461f579271cda3"), + hexstr2bin("38f65d6dce47676044d58ce5139582d568f64bb16098d179dbab07741dd5caf5"), + secp256r1, + hexstr2bin("057d636096cb80b67a8c038c890e887d1adfa4195e9b3ce241c8a778c59cda67")}, + {ecdh, hexstr2point("a7c76b970c3b5fe8b05d2838ae04ab47697b9eaf52e764592efda27fe7513272734466b400091adbf2d68c58e0c50066", "ac68f19f2e1cb879aed43a9969b91a0839c4c38a49749b661efedf243451915ed0905a32b060992b468c64766fc8437a"), + hexstr2bin("3cc3122a68f0d95027ad38c067916ba0eb8c38894d22e1b15618b6818a661774ad463b205da88cf699ab4d43c9cf98a1"), + secp384r1, + hexstr2bin("5f9d29dc5e31a163060356213669c8ce132e22f57c9a04f40ba7fcead493b457e5621e766c40a2e3d4d6a04b25e533f1")}, + {ecdh, hexstr2point("30f43fcf2b6b00de53f624f1543090681839717d53c7c955d1d69efaf0349b7363acb447240101cbb3af6641ce4b88e0", "25e46c0c54f0162a77efcc27b6ea792002ae2ba82714299c860857a68153ab62e525ec0530d81b5aa15897981e858757"), + hexstr2bin("92860c21bde06165f8e900c687f8ef0a05d14f290b3f07d8b3a8cc6404366e5d5119cd6d03fb12dc58e89f13df9cd783"), + secp384r1, + hexstr2bin("a23742a2c267d7425fda94b93f93bbcc24791ac51cd8fd501a238d40812f4cbfc59aac9520d758cf789c76300c69d2ff")}, + {ecdh, hexstr2point("00685a48e86c79f0f0875f7bc18d25eb5fc8c0b07e5da4f4370f3a9490340854334b1e1b87fa395464c60626124a4e70d0f785601d37c09870ebf176666877a2046d", "01ba52c56fc8776d9e8f5db4f0cc27636d0b741bbe05400697942e80b739884a83bde99e0f6716939e632bc8986fa18dccd443a348b6c3e522497955a4f3c302f676"), + hexstr2bin("017eecc07ab4b329068fba65e56a1f8890aa935e57134ae0ffcce802735151f4eac6564f6ee9974c5e6887a1fefee5743ae2241bfeb95d5ce31ddcb6f9edb4d6fc47"), + secp521r1, + hexstr2bin("005fc70477c3e63bc3954bd0df3ea0d1f41ee21746ed95fc5e1fdf90930d5e136672d72cc770742d1711c3c3a4c334a0ad9759436a4d3c5bf6e74b9578fac148c831")}, + {ecdh, hexstr2point("01df277c152108349bc34d539ee0cf06b24f5d3500677b4445453ccc21409453aafb8a72a0be9ebe54d12270aa51b3ab7f316aa5e74a951c5e53f74cd95fc29aee7a", "013d52f33a9f3c14384d1587fa8abe7aed74bc33749ad9c570b471776422c7d4505d9b0a96b3bfac041e4c6a6990ae7f700e5b4a6640229112deafa0cd8bb0d089b0"), + hexstr2bin("00816f19c1fb10ef94d4a1d81c156ec3d1de08b66761f03f06ee4bb9dcebbbfe1eaa1ed49a6a990838d8ed318c14d74cc872f95d05d07ad50f621ceb620cd905cfb8"), + secp521r1, + hexstr2bin("000b3920ac830ade812c8f96805da2236e002acbbf13596a9ab254d44d0e91b6255ebf1229f366fb5a05c5884ef46032c26d42189273ca4efa4c3db6bd12a6853759")}, + + %% RFC-6954, Appendix A + {ecdh, hexstr2point("A9C21A569759DA95E0387041184261440327AFE33141CA04B82DC92E", + "98A0F75FBBF61D8E58AE5511B2BCDBE8E549B31E37069A2825F590C1"), + hexstr2bin("6060552303899E2140715816C45B57D9B42204FB6A5BF5BEAC10DB00"), + brainpoolP224r1, + hexstr2bin("1A4BFE705445120C8E3E026699054104510D119757B74D5FE2462C66")}, + {ecdh, hexstr2point("034A56C550FF88056144E6DD56070F54B0135976B5BF77827313F36B", + "75165AD99347DC86CAAB1CBB579E198EAF88DC35F927B358AA683681"), + hexstr2bin("39F155483CEE191FBECFE9C81D8AB1A03CDA6790E7184ACE44BCA161"), + brainpoolP224r1, + hexstr2bin("1A4BFE705445120C8E3E026699054104510D119757B74D5FE2462C66")}, + {ecdh, hexstr2point("44106E913F92BC02A1705D9953A8414DB95E1AAA49E81D9E85F929A8E3100BE5", + "8AB4846F11CACCB73CE49CBDD120F5A900A69FD32C272223F789EF10EB089BDC"), + hexstr2bin("55E40BC41E37E3E2AD25C3C6654511FFA8474A91A0032087593852D3E7D76BD3"), + brainpoolP256r1, + hexstr2bin("89AFC39D41D3B327814B80940B042590F96556EC91E6AE7939BCE31F3A18BF2B")}, + {ecdh, hexstr2point("8D2D688C6CF93E1160AD04CC4429117DC2C41825E1E9FCA0ADDD34E6F1B39F7B", + "990C57520812BE512641E47034832106BC7D3E8DD0E4C7F1136D7006547CEC6A"), + hexstr2bin("81DB1EE100150FF2EA338D708271BE38300CB54241D79950F77B063039804F1D"), + brainpoolP256r1, + hexstr2bin("89AFC39D41D3B327814B80940B042590F96556EC91E6AE7939BCE31F3A18BF2B")}, + {ecdh, hexstr2point("68B665DD91C195800650CDD363C625F4E742E8134667B767B1B476793588F885AB698C852D4A6E77A252D6380FCAF068", + "55BC91A39C9EC01DEE36017B7D673A931236D2F1F5C83942D049E3FA20607493E0D038FF2FD30C2AB67D15C85F7FAA59"), + hexstr2bin("032640BC6003C59260F7250C3DB58CE647F98E1260ACCE4ACDA3DD869F74E01F8BA5E0324309DB6A9831497ABAC96670"), + brainpoolP384r1, + hexstr2bin("0BD9D3A7EA0B3D519D09D8E48D0785FB744A6B355E6304BC51C229FBBCE239BBADF6403715C35D4FB2A5444F575D4F42")}, + {ecdh, hexstr2point("4D44326F269A597A5B58BBA565DA5556ED7FD9A8A9EB76C25F46DB69D19DC8CE6AD18E404B15738B2086DF37E71D1EB4", + "62D692136DE56CBE93BF5FA3188EF58BC8A3A0EC6C1E151A21038A42E9185329B5B275903D192F8D4E1F32FE9CC78C48"), + hexstr2bin("1E20F5E048A5886F1F157C74E91BDE2B98C8B52D58E5003D57053FC4B0BD65D6F15EB5D1EE1610DF870795143627D042"), + brainpoolP384r1, + hexstr2bin("0BD9D3A7EA0B3D519D09D8E48D0785FB744A6B355E6304BC51C229FBBCE239BBADF6403715C35D4FB2A5444F575D4F42")}, + {ecdh, hexstr2point("0A420517E406AAC0ACDCE90FCD71487718D3B953EFD7FBEC5F7F27E28C6149999397E91E029E06457DB2D3E640668B392C2A7E737A7F0BF04436D11640FD09FD", + "72E6882E8DB28AAD36237CD25D580DB23783961C8DC52DFA2EC138AD472A0FCEF3887CF62B623B2A87DE5C588301EA3E5FC269B373B60724F5E82A6AD147FDE7"), + hexstr2bin("230E18E1BCC88A362FA54E4EA3902009292F7F8033624FD471B5D8ACE49D12CFABBC19963DAB8E2F1EBA00BFFB29E4D72D13F2224562F405CB80503666B25429"), + brainpoolP512r1, + hexstr2bin("A7927098655F1F9976FA50A9D566865DC530331846381C87256BAF3226244B76D36403C024D7BBF0AA0803EAFF405D3D24F11A9B5C0BEF679FE1454B21C4CD1F")}, + {ecdh, hexstr2point("9D45F66DE5D67E2E6DB6E93A59CE0BB48106097FF78A081DE781CDB31FCE8CCBAAEA8DD4320C4119F1E9CD437A2EAB3731FA9668AB268D871DEDA55A5473199F", + "2FDC313095BCDD5FB3A91636F07A959C8E86B5636A1E930E8396049CB481961D365CC11453A06C719835475B12CB52FC3C383BCE35E27EF194512B71876285FA"), + hexstr2bin("16302FF0DBBB5A8D733DAB7141C1B45ACBC8715939677F6A56850A38BD87BD59B09E80279609FF333EB9D4C061231FB26F92EEB04982A5F1D1764CAD57665422"), + brainpoolP512r1, + hexstr2bin("A7927098655F1F9976FA50A9D566865DC530331846381C87256BAF3226244B76D36403C024D7BBF0AA0803EAFF405D3D24F11A9B5C0BEF679FE1454B21C4CD1F")}], + lists:filter(fun ({_Type, _Pub, _Priv, Curve, _SharedSecret}) -> + lists:member(Curve, Curves) + end, + TestCases). dh() -> {dh, 0087761979513264537414556992123116644042638206717762626089877284926656954974893442000747478454809111207351620687968672207938731607963470779396984752680274820156266685080223616226905101126463253150237669547023934604953898814222890239130021414026118792251620881355456432549881723310342870016961804255746630219, 2}. @@ -2162,18 +2262,24 @@ ecc() -> %% information about the curves see %% http://csrc.nist.gov/encryption/dss/ecdsa/NISTReCur.pdf %% - [{ecdh,secp192r1,1, - hexstr2point("188DA80EB03090F67CBF20EB43A18800F4FF0AFD82FF1012", - "07192B95FFC8DA78631011ED6B24CDD573F977A11E794811")}, - {ecdh,secp192r1,2, - hexstr2point("DAFEBF5828783F2AD35534631588A3F629A70FB16982A888", - "DD6BDA0D993DA0FA46B27BBC141B868F59331AFA5C7E93AB")}, - {ecdh,secp192r1,3, - hexstr2point("76E32A2557599E6EDCD283201FB2B9AADFD0D359CBB263DA", - "782C37E372BA4520AA62E0FED121D49EF3B543660CFD05FD")}, - {ecdh,secp192r1,4, - hexstr2point("35433907297CC378B0015703374729D7A4FE46647084E4BA", - "A2649984F2135C301EA3ACB0776CD4F125389B311DB3BE32")}]. + Curves = crypto:ec_curves(), + TestCases = + [{ecdh,secp192r1,1, + hexstr2point("188DA80EB03090F67CBF20EB43A18800F4FF0AFD82FF1012", + "07192B95FFC8DA78631011ED6B24CDD573F977A11E794811")}, + {ecdh,secp192r1,2, + hexstr2point("DAFEBF5828783F2AD35534631588A3F629A70FB16982A888", + "DD6BDA0D993DA0FA46B27BBC141B868F59331AFA5C7E93AB")}, + {ecdh,secp192r1,3, + hexstr2point("76E32A2557599E6EDCD283201FB2B9AADFD0D359CBB263DA", + "782C37E372BA4520AA62E0FED121D49EF3B543660CFD05FD")}, + {ecdh,secp192r1,4, + hexstr2point("35433907297CC378B0015703374729D7A4FE46647084E4BA", + "A2649984F2135C301EA3ACB0776CD4F125389B311DB3BE32")}], + lists:filter(fun ({_Type, Curve, _Priv, _Pub}) -> + lists:member(Curve, Curves) + end, + TestCases). no_padding() -> Public = [_, Mod] = rsa_public(), diff --git a/lib/crypto/test/old_crypto_SUITE.erl b/lib/crypto/test/old_crypto_SUITE.erl index b5894b070d..37cce2ebd2 100644 --- a/lib/crypto/test/old_crypto_SUITE.erl +++ b/lib/crypto/test/old_crypto_SUITE.erl @@ -19,7 +19,7 @@ %% -module(old_crypto_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -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, @@ -1888,48 +1888,12 @@ ec(Config) when is_list(Config) -> ec_do() -> %% test for a name curve - {D2_pub, D2_priv} = crypto:generate_key(ecdh, secp112r2), - PrivECDH = [D2_priv, secp112r2], - PubECDH = [D2_pub, secp112r2], + NamedCurve = hd(crypto:ec_curves()), + {D2_pub, D2_priv} = crypto:generate_key(ecdh, NamedCurve), + PrivECDH = [D2_priv, NamedCurve], + PubECDH = [D2_pub, NamedCurve], %%TODO: find a published test case for a EC key - %% test for a full specified curve and public key, - %% taken from csca-germany_013_self_signed_cer.pem - PubKey = <<16#04, 16#4a, 16#94, 16#49, 16#81, 16#77, 16#9d, 16#df, - 16#1d, 16#a5, 16#e7, 16#c5, 16#27, 16#e2, 16#7d, 16#24, - 16#71, 16#a9, 16#28, 16#eb, 16#4d, 16#7b, 16#67, 16#75, - 16#ae, 16#09, 16#0a, 16#51, 16#45, 16#19, 16#9b, 16#d4, - 16#7e, 16#a0, 16#81, 16#e5, 16#5e, 16#d4, 16#a4, 16#3f, - 16#60, 16#7c, 16#6a, 16#50, 16#ee, 16#36, 16#41, 16#8a, - 16#87, 16#ff, 16#cd, 16#a6, 16#10, 16#39, 16#ca, 16#95, - 16#76, 16#7d, 16#ae, 16#ca, 16#c3, 16#44, 16#3f, 16#e3, 16#2c>>, - <<P:264/integer>> = <<16#00, 16#a9, 16#fb, 16#57, 16#db, 16#a1, 16#ee, 16#a9, - 16#bc, 16#3e, 16#66, 16#0a, 16#90, 16#9d, 16#83, 16#8d, - 16#72, 16#6e, 16#3b, 16#f6, 16#23, 16#d5, 16#26, 16#20, - 16#28, 16#20, 16#13, 16#48, 16#1d, 16#1f, 16#6e, 16#53, 16#77>>, - <<A:256/integer>> = <<16#7d, 16#5a, 16#09, 16#75, 16#fc, 16#2c, 16#30, 16#57, - 16#ee, 16#f6, 16#75, 16#30, 16#41, 16#7a, 16#ff, 16#e7, - 16#fb, 16#80, 16#55, 16#c1, 16#26, 16#dc, 16#5c, 16#6c, - 16#e9, 16#4a, 16#4b, 16#44, 16#f3, 16#30, 16#b5, 16#d9>>, - <<B:256/integer>> = <<16#26, 16#dc, 16#5c, 16#6c, 16#e9, 16#4a, 16#4b, 16#44, - 16#f3, 16#30, 16#b5, 16#d9, 16#bb, 16#d7, 16#7c, 16#bf, - 16#95, 16#84, 16#16, 16#29, 16#5c, 16#f7, 16#e1, 16#ce, - 16#6b, 16#cc, 16#dc, 16#18, 16#ff, 16#8c, 16#07, 16#b6>>, - BasePoint = <<16#04, 16#8b, 16#d2, 16#ae, 16#b9, 16#cb, 16#7e, 16#57, - 16#cb, 16#2c, 16#4b, 16#48, 16#2f, 16#fc, 16#81, 16#b7, - 16#af, 16#b9, 16#de, 16#27, 16#e1, 16#e3, 16#bd, 16#23, - 16#c2, 16#3a, 16#44, 16#53, 16#bd, 16#9a, 16#ce, 16#32, - 16#62, 16#54, 16#7e, 16#f8, 16#35, 16#c3, 16#da, 16#c4, - 16#fd, 16#97, 16#f8, 16#46, 16#1a, 16#14, 16#61, 16#1d, - 16#c9, 16#c2, 16#77, 16#45, 16#13, 16#2d, 16#ed, 16#8e, - 16#54, 16#5c, 16#1d, 16#54, 16#c7, 16#2f, 16#04, 16#69, 16#97>>, - <<Order:264/integer>> = <<16#00, 16#a9, 16#fb, 16#57, 16#db, 16#a1, 16#ee, 16#a9, - 16#bc, 16#3e, 16#66, 16#0a, 16#90, 16#9d, 16#83, 16#8d, - 16#71, 16#8c, 16#39, 16#7a, 16#a3, 16#b5, 16#61, 16#a6, - 16#f7, 16#90, 16#1e, 16#0e, 16#82, 16#97, 16#48, 16#56, 16#a7>>, - CoFactor = 1, - Curve = {{prime_field,P},{A,B,none},BasePoint, Order,CoFactor}, - Msg = <<99,234,6,64,190,237,201,99,80,248,58,40,70,45,149,218,5,246,242,63>>, Sign = crypto:sign(ecdsa, sha, Msg, PrivECDH), ?line true = crypto:verify(ecdsa, sha, Msg, Sign, PubECDH), diff --git a/lib/debugger/doc/src/book.xml b/lib/debugger/doc/src/book.xml index 071a04eb61..5424ef2c04 100644 --- a/lib/debugger/doc/src/book.xml +++ b/lib/debugger/doc/src/book.xml @@ -47,4 +47,3 @@ <index/> </book> - diff --git a/lib/debugger/doc/src/debugger.xml b/lib/debugger/doc/src/debugger.xml index 15d498d5ae..1ecdbcd064 100644 --- a/lib/debugger/doc/src/debugger.xml +++ b/lib/debugger/doc/src/debugger.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2002</year><year>2013</year> + <year>2002</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -29,7 +29,7 @@ <rev></rev> </header> <module>debugger</module> - <modulesummary>Erlang Debugger</modulesummary> + <modulesummary>Erlang Debugger.</modulesummary> <description> <p>Erlang Debugger for debugging and testing of Erlang programs.</p> </description> @@ -48,14 +48,14 @@ <desc> <p>Starts Debugger.</p> - <p>If given a file name as argument, Debugger will try to load - its settings from this file. Refer to Debugger User's Guide - for more information about settings.</p> + <p>If a filename is specified as argument, Debugger tries to load + its settings from this file. For details about settings, see + the User's Guide.</p> - <p>If given <c>local</c> as argument, Debugger will interpret - code only at the current node. If given <c>global</c> as - argument, Debugger will interpret code at all known nodes, - this is the default.</p> + <p>If <c>local</c> is specified as argument, Debugger interprets + code only at the current node. If <c>global</c> is specified as + argument, Debugger interprets code at all known nodes, this + is the default.</p> </desc> </func> @@ -67,11 +67,9 @@ <v>Args = [term()]</v> </type> <desc> - <p>This function can be used to debug a single process. - The module <c>Module</c> is interpreted and - <c>apply(Module,Name,Args)</c> is called. This will open an - Attach Process window, refer to Debugger User's Guide for - more information.</p> + <p>Debugs a single process. The module <c>Module</c> is interpreted + and <c>apply(Module,Name,Args)</c> is called. This opens an + Attach Process window. For details, see the User's Guide.</p> </desc> </func> </funcs> diff --git a/lib/debugger/doc/src/debugger_chapter.xml b/lib/debugger/doc/src/debugger_chapter.xml index 98fe4ae377..45dfdb3776 100644 --- a/lib/debugger/doc/src/debugger_chapter.xml +++ b/lib/debugger/doc/src/debugger_chapter.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>1997</year><year>2013</year> + <year>1997</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -31,97 +31,92 @@ </header> <section> - <title>Introduction</title> + <title>Getting Started</title> - <p><em>Debugger</em> is a graphical user interface for the Erlang - interpreter, which can be used for debugging and testing of - Erlang programs. For example, breakpoints can be set, code can be - single stepped and variable values can be displayed and changed. - </p> + <p>To use Debugger, the basic steps are as follows:</p> - <p>The Erlang interpreter can also be accessed via the interface - module <c>int</c>, see <seealso marker="int">int(3)</seealso>. - </p> + <p><em>Step 1.</em> Start Debugger by calling + <c>debugger:start()</c>.</p> - <p><em>Warning:</em> Note that the Debugger at some point might - start tracing on the processes which execute the interpreted - code. This means that a conflict will occur if tracing by other - means is started on any of these processes.</p> - </section> + <p>The <seealso marker="#monitor">Monitor window</seealso> is + displayed with information about all debugged processes, + interpreted modules, and selected options. Initially there are + normally no debugged processes. First, it must be specified which + modules that are to be <em>debugged</em> (also called + <em>interpreted</em>). Proceed as follows:</p> - <section> - <title>Getting Started with Debugger</title> + <p><em>Step 2.</em> Select <em>Module > Interpret...</em> in the + Monitor window.</p> - <p>Start Debugger by calling <c>debugger:start()</c>. It will start - the <seealso marker="#monitor">Monitor window</seealso> showing - information about all debugged processes, interpreted modules and - selected options.</p> + <p>The <seealso marker="#interpret">Interpret Modules window</seealso> + is displayed.</p> - <p>Initially there are normally no debugged processes. First, it - must be specified which modules should be <em>debugged</em>, or - <em>interpreted</em> as it is also called. This is done by - choosing <em>Module->Interpret...</em> in the Monitor window and - then selecting the appropriate modules from the - <seealso marker="#interpret">Interpret Dialog window</seealso>. - </p> + <p><em>Step 3.</em> Select the appropriate modules from the Interpret + Dialog window.</p> <note> - <p>Only modules compiled with the option <c>debug_info</c> set - can be interpreted. Non-interpretable modules are shown within - parenthesis in the Interpret Dialog window.</p> + <p>Only modules compiled with option <c>debug_info</c> set can be + interpreted. Non-interpretable modules are displayed within + parenthesis in the Interpret Modules window.</p> </note> - <p>When a module is interpreted, it can be viewed in a - <seealso marker="#view">View Module window</seealso>. This is done - by selecting the module from the <em>Module->module->View</em> - menu. The contents of the source file is shown and it is possible - to set <seealso marker="#breakpoints">breakpoints</seealso>.</p> - - <p>Now the program that should be debugged can be started. This is - done the normal way from the Erlang shell. All processes executing - code in interpreted modules will be displayed in the Monitor - window. It is possible to <em>attach</em> to one of these - processes, by double-clicking it, or by selecting the process and - then choosing <em>Process->Attach</em>.</p> - - <p>Attaching to a process will result in a - <seealso marker="#attach">Attach Process window</seealso> being - opened for this process. From the Attach Process window, it is - possible to control the process execution, inspect variable - values, set breakpoints etc.</p> + <p><em>Step 4.</em> In the Monitor window, select + <em>Module > the module to be interpreted > View</em>.</p> + + <p>The contents of the source file is displayed in the + <seealso marker="#view">View Module window</seealso>.</p> + + <p><em>Step 5.</em> Set the + <seealso marker="#breakpoints">breakpoints</seealso>, if any.</p> + + <p><em>Step 6.</em> Start the program to be debugged. This is done + the normal way from the Erlang shell.</p> + + <p>All processes executing code in interpreted modules are displayed + in the Monitor window.</p> + + <p><em>Step 7.</em> To <em>attach</em> to one of these processes, + double-click it, or select the process and then choose + <em>Process > Attach</em>. Attaching to a process opens an + <seealso marker="#attach">Attach Process window</seealso> for this + process.</p> + + <p><em>Step 8.</em> From the Attach Process window, you can control + the process execution, inspect variable values, set breakpoints, + and so on.</p> </section> <section> <marker id="breakpoints"/> - <title>Breakpoints and Break Dialogue Windows</title> + <title>Breakpoints and Break Dialog Windows</title> <p>Once the appropriate modules are interpreted, breakpoints can be set at relevant locations in the source code. Breakpoints are specified on a line basis. When a process reaches a breakpoint, - it stops and waits for commands (step, skip, continue,...) from - the user.</p> + it stops and waits for commands (<em>Step</em>, <em>Skip</em>, + <em>Continue</em> ...) from the user.</p> <note> <p>When a process reaches a breakpoint, only that process is - stopped. Other processes are not affected.</p> + stopped. Other processes are not affected.</p> </note> - <p>Breakpoints are created and deleted using the Break menu of - the Monitor window, View Module window and Attach Process window. - </p> + <p>Breakpoints are created and deleted using the <em>Break</em> menu of + either the Monitor window, View Module window, or Attach Process + window.</p> <section> <title>Executable Lines</title> - <p>To have effect, a breakpoint must be set at an - <em>executable line</em>, which is a line of code containing an - executable expression such as a matching or a function call. - A blank line or a line containing a comment, function head or - pattern in a <c>case</c>- or <c>receive</c> statement is not - executable.</p> + <p>To have an effect, a breakpoint must be set at an + <em>executable line</em>, which is a line of code containing an + executable expression such as a matching or a function call. + A blank line or a line containing a comment, function head, or + pattern in a <c>case</c> statement or <c>receive</c> statement is not + executable.</p> - <p>In the example below, lines number 2, 4, 6, 8 and 11 are - executable lines:</p> + <p>In the following example, lines 2, 4, 6, 8, and 11 are + executable lines:</p> <pre> 1: is_loaded(Module,Compiled) -> 2: case get_file(Module,Compiled) of @@ -141,17 +136,15 @@ <title>Status and Trigger Action</title> <p>A breakpoint can be either <em>active</em> or - <em>inactive</em>. Inactive breakpoints are ignored.</p> - - <p>Each breakpoint has a <em>trigger action</em> which specifies - what should happen when a process has reached it (and stopped): - </p> - <list> - <item><em>enable</em> Breakpoint should remain active (default). - </item> - <item><em>disable</em> Breakpoint should be made inactive. - </item> - <item><em>delete</em> Breakpoint should be deleted.</item> + <em>inactive</em>. Inactive breakpoints are ignored.</p> + + <p>Each breakpoint has a <em>trigger action</em> that specifies + what is to happen when a process has reached it (and stopped):</p> + <list type="bulleted"> + <item><em>Enable</em> - Breakpoint is to remain active (default). + </item> + <item><em>Disable</em> - Breakpoint is to be made inactive.</item> + <item><em>Delete</em> - Breakpoint is to be deleted.</item> </list> </section> @@ -161,54 +154,56 @@ <p>A line breakpoint is created at a certain line in a module.</p> <image file="images/line_break_dialog.jpg"> - <icaption>The Line Break Dialog Window.</icaption> + <icaption>Line Break Dialog Window</icaption> </image> - <p>Right-clicking the Module entry will open a popup menu from - which the appropriate module can be selected.</p> + <p>Right-click the <em>Module</em> entry to open a popup menu from + which the appropriate module can be selected.</p> - <p>A line breakpoint can also be created (and deleted) by - double-clicking the line when the module is displayed in - the View Module or Attach Process window.</p> + <p>A line breakpoint can also be created (and deleted) by + double-clicking the line when the module is displayed in + the View Module window or Attach Process window.</p> </section> <section> <title>Conditional Breakpoints</title> <p>A conditional breakpoint is created at a certain line in - the module, but a process reaching the breakpoint will stop - only if a given condition is true.</p> + the module, but a process reaching the breakpoint stops + only if a specified condition is true.</p> <p>The condition is specified by the user as a module name - <c>CModule</c> and a function name <c>CFunction</c>. When a - process reaches the breakpoint, - <c>CModule:CFunction(Bindings)</c> will be evaluated. If and - only if this function call returns <c>true</c>, the process - will stop. If the function call returns <c>false</c>, - the breakpoint will be silently ignored.</p> - - <p><c>Bindings</c> is a list of variable bindings. Use - the function <c>int:get_binding(Variable,Bindings)</c> to - retrieve the value of <c>Variable</c> (given as an atom). - The function returns <c>unbound</c> or <c>{value,Value}</c>.</p> + <c>CModule</c> and a function name <c>CFunction</c>. When a + process reaches the breakpoint, + <c>CModule:CFunction(Bindings)</c> is evaluated. If and + only if this function call returns <c>true</c>, the process + stops. If the function call returns <c>false</c>, + the breakpoint is silently ignored.</p> + + <p><c>Bindings</c> is a list of variable bindings. To retrieve the + value of <c>Variable</c> (given as an atom), use function + <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"> - <icaption>The Conditional Break Dialog Window.</icaption> + <icaption>Conditional Break Dialog Window</icaption> </image> - <p>Right-clicking the Module entry will open a popup menu from - which the appropriate module can be selected.</p> + <p>Right-click the <em>Module</em> entry to open a popup menu from + which the appropriate module can be selected.</p> - <p>Example: A conditional breakpoint calling - <c>c_test:c_break/1</c> is added at line 6 in the module + <p><em>Example:</em></p> + + <p>A conditional breakpoint calling + <c>c_test:c_break/1</c> is added at line 6 in module <c>fact</c>. Each time the breakpoint is reached, the function is - called, and when <c>N</c> is equal to 3 it returns <c>true</c>, - and the process stops.</p> - + called. When <c>N</c> is equal to 3, the function returns + <c>true</c> and the process stops.</p> + <p>Extract from <c>fact.erl</c>:</p> <pre> -5. fac(0) -> 1; -6. fac(N) when N > 0, is_integer(N) -> N * fac(N-1).</pre> +5. fac(0) -> 1; +6. fac(N) when N > 0, is_integer(N) -> N * fac(N-1).</pre> <p>Definition of <c>c_test:c_break/1</c>:</p> <pre> @@ -228,18 +223,18 @@ c_break(Bindings) -> <title>Function Breakpoints</title> <p>A function breakpoint is a set of line breakpoints, one at - the first line of each clause in the given function.</p> + the first line of each clause in the specified function.</p> <image file="images/function_break_dialog.jpg"> - <icaption>The Function Break Dialog Window.</icaption> + <icaption>Function Break Dialog Window</icaption> </image> - <p>Right-clicking the Module entry will open a popup menu from - which the appropriate module can be selected.</p> + <p>To open a popup menu from which the appropriate module can be + selected, right-click the <em>Module</em> entry.</p> - <p>Clicking the Ok button (or 'Return' or 'Tab') when a module - name has been given, will bring up all functions of the module - in the listbox.</p> + <p>To bring up all functions of the module in the listbox, + click the <em>OK</em> button (or press the <em>Return</em> + or <em>Tab</em> key) when a module name has been specified,.</p> </section> </section> @@ -249,7 +244,7 @@ c_break(Bindings) -> <p>The Erlang emulator keeps track of a <em>stack trace</em>, information about recent function calls. This information is - used, for example, if an error occurs:</p> + used if an error occurs, for example:</p> <pre> 1> <input>catch a+1.</input> {'EXIT',{badarith,[{erlang,'+',[a,1],[]}, @@ -259,602 +254,597 @@ c_break(Bindings) -> {shell,eval_exprs,7,[{file,"shell.erl"},{line,629}]}, {shell,eval_loop,3,[{file,"shell.erl"},{line,614}]}]}}</pre> - <p>See the Erlang Reference Manual, - <seealso marker="doc/reference_manual:errors"> - Errors and Error Handling</seealso>, - for more information about the stack trace.</p> + <p>For details about the stack trace, see section + <seealso marker="doc/reference_manual:errors">Errors and Error Handling</seealso> + in the Erlang Reference Manual.</p> - <p>The Debugger emulates the stack trace by keeping track of recently + <p>Debugger emulates the stack trace by keeping track of recently called interpreted functions. (The real stack trace cannot be - used, as it shows which functions of the Debugger have been - called, rather than which interpreted functions).</p> + used, as it shows which functions of Debugger have been + called, rather than which interpreted functions.)</p> <p>This information can be used to traverse the chain of function - calls, using the 'Up' and 'Down' buttons of - <seealso marker="#attach">the Attach Process window</seealso>. - </p> + calls, using the <em>Up</em> and <em>Down</em> buttons in the + <seealso marker="#attach">Attach Process window</seealso>.</p> - <p>By default, the Debugger only saves information about recursive + <p>By default, Debugger only saves information about recursive function calls, that is, function calls that have not yet returned - a value (option 'Stack On, No Tail').</p> + a value (option <em>Stack On, No Tail</em>).</p> <p>Sometimes, however, it can be useful to save all calls, even - tail-recursive calls. That can be done with the 'Stack On, Tail' - option. Note that this option will consume more memory and slow - down execution of interpreted functions when there are many - tail-recursive calls. - </p> - - <p>It is also possible to turn off the Debugger stack trace - facility ('Stack Off'). <em>Note:</em> If an error occurs, in this - case the stack trace will be empty.</p> - - <p>See the section about <seealso marker="#monitor">the Monitor - Window</seealso> for information about how to change the stack - trace option.</p> + tail-recursive calls. This is done with option + <em>Stack On, Tail</em>. Notice that this option consumes more + memory and slows down execution of interpreted functions when there + are many tail-recursive calls.</p> + + <p>To turn off the Debugger stack trace facility, select option + <em>Stack Off</em>.</p> + + <note> + <p>If an error occurs, the stack trace becomes empty in this + case.</p> + </note> + + <p>For information about how to change the stack trace option, see + section <seealso marker="#monitor">Monitor Window</seealso>.</p> </section> <section> <marker id="monitor"/> - <title>The Monitor Window</title> + <title>Monitor Window</title> + + <p>The Monitor window is the main window of Debugger and displays the + following:</p> - <p>The Monitor window is the main window of Debugger and shows a - listbox containing the names of all interpreted modules - (double-clicking a module brings up the View Module window), - which options are selected, and information about all debugged - processes, that is all processes which have been/are executing - code in interpreted modules.</p> + <list type="bulleted"> + <item><p>A listbox containing the names of all interpreted + modules</p> + <p>Double-clicking a module brings up the View Module window.</p> + </item> + <item><p>Which options are selected</p></item> + <item><p>Information about all debugged processes, that is, all + processes that have been or are executing code in interpreted + modules</p></item> + </list> <image file="images/monitor.jpg"> - <icaption>The Monitor Window.</icaption> + <icaption>Monitor Window</icaption> </image> - <p>The Auto Attach buttons, Stack Trace label, Back Trace Size - label, and Strings button show some options set, see - <seealso marker="#options">Options Menu</seealso> for further - information about these options.</p> + <p>The <em>Auto Attach</em> boxes, <em>Stack Trace</em> label, + <em>Back Trace Size</em> label, and <em>Strings</em> box display + some options set. For details about these options, see section + <seealso marker="#options">Options Menu</seealso>.</p> <section> <title>Process Grid</title> - <taglist> <tag><em>Pid</em></tag> <item><p>The process identifier.</p></item> - + <tag><em>Initial Call</em></tag> <item><p>The first call to an interpreted function by this - process. (<c>Module:Function/Arity</c>)</p></item> + process. (<c>Module:Function/Arity</c>)</p></item> <tag><em>Name</em></tag> - <item><p>The registered name, if any. If a registered name does - not show up, it may be that the Debugger received - information about the process before the name had been - registered. Try selecting <em>Edit->Refresh</em>.</p></item> + <item><p>The registered name, if any. If a registered name is not + displayed, it can be that Debugger received information about + the process before the name was registered. Try selecting + <em>Edit > Refresh</em>.</p></item> <tag><em>Status</em></tag> <item><p>The current status, one of the following:</p> <taglist> <tag><em>idle</em></tag> - <item><p>The interpreted function call has returned a value, - and the process is no longer executing interpreted code. - </p></item> + <item><p>The interpreted function call has returned a value, and + the process is no longer executing interpreted code.</p></item> <tag><em>running</em></tag> <item><p>The process is running.</p></item> - + <tag><em>waiting</em></tag> <item><p>The process is waiting in a <c>receive</c> - statement.</p></item> - + statement.</p></item> + <tag><em>break</em></tag> <item><p>The process is stopped at a breakpoint.</p></item> - + <tag><em>exit</em></tag> <item><p>The process has terminated.</p></item> - + <tag><em>no_conn</em></tag> <item><p>There is no connection to the node where - the process is located.</p></item> + the process is located.</p></item> </taglist> </item> <tag><em>Information</em></tag> - <item><p>Additional information, if any. If the process is - stopped at a breakpoint, the field contains information - about the location <c>{Module,Line}</c>. If the process has - terminated, the field contains the exit reason.</p></item> + <item><p>More information, if any. If the process is + stopped at a breakpoint, the field contains information + about the location <c>{Module,Line}</c>. If the process has + terminated, the field contains the exit reason.</p></item> </taglist> </section> <section> - <title>The File Menu</title> - + <title>File Menu</title> + <taglist> <tag><em>Load Settings...</em></tag> - <item> - <p>Try to load and restore Debugger settings from a file - previously saved using <em>Save Settings...</em>, see below. - Any errors are silently ignored. - <em>Note:</em> Settings saved by Erlang R16B01 or later - cannot be read by Erlang R16B or earlier.</p> + <item><p>Tries to load and restore Debugger settings from a file + previously saved using <em>Save Settings...</em> (see below). + Any errors are silently ignored.</p> + <p>Notice that settings saved by Erlang/OTP R16B01 or later + cannot be read by Erlang/OTP R16B or earlier.</p> </item> - + <tag><em>Save Settings...</em></tag> - <item><p>Save Debugger settings to a file. The settings include - the set of interpreted files, breakpoints, and the selected - options. The settings can be restored in a later Debugger - session using <em>Load Settings...</em>, see above. - Any errors are silently ignored.</p> + <item><p>Saves Debugger settings to a file. The settings include + the set of interpreted files, breakpoints, and the selected + options. The settings can be restored in a later Debugger + session using <em>Load Settings...</em> (see above). + Any errors are silently ignored.</p> </item> - + <tag><em>Exit</em></tag> - <item><p>Stop Debugger.</p></item> + <item><p>Stops Debugger.</p></item> </taglist> </section> <section> - <title>The Edit Menu</title> + <title>Edit Menu</title> <taglist> <tag><em>Refresh</em></tag> - <item><p>Update information about debugged processes. Removes - information about all terminated processes from the window, - and also closes all Attach Process windows for terminated - processes.</p></item> + <item><p>Updates information about debugged processes. Information + about all terminated processes are removed from the window. All + Attach Process windows for terminated processes are closed.</p></item> <tag><em>Kill All</em></tag> - <item><p>Terminate all processes listed in the window using - <c>exit(Pid,kill)</c>.</p></item> + <item><p>Terminates all processes listed in the window using + <c>exit(Pid,kill)</c>.</p></item> </taglist> </section> <section> - <title>The Module Menu</title> + <title>Module Menu</title> <taglist> <tag><em>Interpret...</em></tag> - <item><p>Open the <seealso marker="#interpret">Interpret Dialog - window</seealso> where new modules to be interpreted can - be specified.</p></item> - + <item><p>Opens the + <seealso marker="#interpret">Interpret Modules window</seealso>, + where new modules to be interpreted can be specified.</p></item> + <tag><em>Delete All</em></tag> - <item><p>Stop interpreting all modules. Processes executing in - interpreted modules will terminate.</p></item> + <item><p>Stops interpreting all modules. Processes executing in + interpreted modules terminate.</p></item> </taglist> <p>For each interpreted module, a corresponding entry is added to - the Module menu, with the following submenu:</p> + the <em>Module</em> menu, with the following submenu:</p> <taglist> <tag><em>Delete</em></tag> - <item><p>Stop interpreting the selected module. Processes - executing in this module will terminate.</p></item> - + <item><p>Stops interpreting the selected module. Processes + executing in this module terminate.</p></item> + <tag><em>View</em></tag> - <item><p>Open a <seealso marker="#view">View Module - window</seealso> showing the contents of the selected - module.</p></item> + <item><p>Opens a + <seealso marker="#view">View Module window</seealso>, displaying the + contents of the selected module.</p></item> </taglist> </section> <section> - <title>The Process Menu</title> + <title>Process Menu</title> <p>The following menu items apply to the currently selected - process, provided it is stopped at a breakpoint. See the chapter - about the <seealso marker="#attach">Attach Process - window</seealso> for more information.</p> + process, provided it is stopped at a breakpoint (for details, see + section + <seealso marker="#attach">Attach Process window</seealso>):</p> <taglist> <tag><em>Step</em></tag><item></item> <tag><em>Next</em></tag><item></item> <tag><em>Continue</em></tag><item></item> <tag><em>Finish</em></tag><item></item> </taglist> + <p>The following menu items apply to the currently selected - process.</p> + process:</p> <taglist> <tag><em>Attach</em></tag> - <item><p>Attach to the process and open a - <seealso marker="#attach">Attach Process window</seealso>. - </p></item> - + <item><p>Attaches to the process and open an + <seealso marker="#attach">Attach Process window</seealso>.</p></item> + <tag><em>Kill</em></tag> - <item><p>Terminate the process using <c>exit(Pid,kill)</c>.</p> - </item> + <item><p>Terminates the process using <c>exit(Pid,kill)</c>.</p></item> </taglist> </section> - <section> - <title>The Break Menu</title> - <p>The items in this menu are used to create and delete - breakpoints. - See the <seealso marker="#breakpoints">Breakpoints</seealso> - chapter for more information.</p> + <section> + <title>Break Menu</title> + <p>The items in this menu are used to create and delete breakpoints. + For details, see section + <seealso marker="#breakpoints">Breakpoints</seealso>.</p> + <taglist> <tag><em>Line Break...</em></tag> - <item><p>Set a line breakpoint.</p></item> + <item><p>Sets a line breakpoint.</p></item> <tag><em>Conditional Break...</em></tag> - <item><p>Set a conditional breakpoint.</p></item> + <item><p>Sets a conditional breakpoint.</p></item> <tag><em>Function Break...</em></tag> - <item><p>Set a function breakpoint.</p></item> + <item><p>Sets a function breakpoint.</p></item> <tag><em>Enable All</em></tag> - <item><p>Enable all breakpoints.</p></item> + <item><p>Enables all breakpoints.</p></item> <tag><em>Disable All</em></tag> - <item><p>Disable all breakpoints.</p></item> + <item><p>Disables all breakpoints.</p></item> - <tag><em>Delete All</em></tag> - <item><p>Remove all breakpoints.</p></item> + <tag><em>Delete All</em></tag> + <item><p>Removes all breakpoints.</p></item> </taglist> - <p>For each breakpoint, a corresponding entry is added to - the Break - menu, from which it is possible to disable/enable or delete - the breakpoint, and to change its trigger action.</p> + <p>For each breakpoint, a corresponding entry is added to the + <em>Break</em> menu, from which it is possible to disable, enable, + or delete the breakpoint, and to change its trigger action.</p> </section> <section> <marker id="options"/> - <title>The Options Menu</title> + <title>Options Menu</title> <taglist> <tag><em>Trace Window</em></tag> - <item><p>Set which areas should be visible in - an <seealso marker="#attach">Attach Process - window</seealso>. Does not affect already existing - Attach Process windows.</p> + <item><p>Sets the areas to be visible in an + <seealso marker="#attach">Attach Process window</seealso>. + Does not affect existing Attach Process windows.</p> </item> <tag><em>Auto Attach</em></tag> - <item><p>Set at which events a debugged process should be - automatically attached to. Affects existing debugged - processes.</p> - <list> - <item><em>First Call</em> - the first time a process calls a - function in an interpreted module.</item> - <item><em>On Exit</em> - at process termination.</item> - <item><em>On Break</em> - when a process reaches a - breakpoint.</item> + <item><p>Sets the events a debugged process is to be attached + to automatically. Affects existing debugged processes.</p> + <list type="bulleted"> + <item><p><em>First Call</em> - The first time a process calls + a function in an interpreted module.</p></item> + <item><p><em>On Exit</em> - At process termination.</p></item> + <item><p><em>On Break</em> - When a process reaches a + breakpoint.</p></item> </list> </item> <tag><em>Stack Trace</em></tag> - <item><p>Set stack trace option, see section + <item><p>Sets the stack trace option, see section <seealso marker="#stack_trace">Stack Trace</seealso>. Does not - affect already existing debugged processes.</p> - <list> - <item><em>Stack On, Tail</em> - save information about all - current calls.</item> - <item><em>Stack On, No Tail</em> - save information about + affect existing debugged processes.</p> + <list type="bulleted"> + <item><p><em>Stack On, Tail</em> - Saves information about all + current calls.</p></item> + <item><p><em>Stack On, No Tail</em> - Saves information about current calls, discarding previous information when a tail - recursive call is made.</item> - <item><em>Stack Off</em> - do not save any information about - current calls.</item> + recursive call is made.</p></item> + <item><p><em>Stack Off</em> - Does not save any information about + current calls.</p></item> </list> </item> <tag><em>Strings</em></tag> - <item><p>Set which integer lists should be printed as strings. - Does not affect already existing debugged processes.</p> - <list> - - <item><em>Use range of +pc flag</em> - use the printable - character range set by the - <seealso marker="erts:erl#printable_character_range"> - <c>erl(1)</c></seealso> flag <c>+pc</c>. - </item> + <item><p>Sets the integer lists to be printed as strings. + Does not affect existing debugged processes.</p> + <list type="bulleted"> + <item><p><em>Use range of +pc flag</em> - Uses the printable + character range set by the <c>erl(1)</c> flag + <seealso marker="erts:erl#printable_character_range"><c>+pc</c></seealso>.</p> + </item> </list> </item> <tag><em>Back Trace Size...</em></tag> - <item><p>Set how many call frames should be fetched when - inspecting the call stack from the Attach Process window. - Does not affect already existing Attach Process windows.</p> + <item><p>Sets how many call frames to be fetched when + inspecting the call stack from the Attach Process window. + Does not affect existing Attach Process windows.</p> </item> </taglist> </section> <section> - <title>The Windows Menu</title> + <title>Windows Menu</title> <p>Contains a menu item for each open Debugger window. Selecting - one of the items will raise the corresponding window.</p> + one of the items raises the corresponding window.</p> </section> <section> - <title>The Help Menu</title> + <title>Help Menu</title> <taglist> <tag><em>Help</em></tag> - <item><p>View the Debugger documentation. Currently this - function requires a web browser to be up and running.</p></item> + <item><p>Shows the Debugger documentation. This function requires a + web browser.</p></item> </taglist> </section> </section> - + <section> <marker id="interpret"/> - <title>The Interpret Dialog Window</title> + <title>Interpret Modules Window</title> - <p>The interpret dialog module is used for selecting which modules - to interpret. Initially, the window shows the modules (<c>erl</c> - files) and subdirectories of the current working directory.</p> + <p>The Interpret Modules window is used for selecting which modules + to interpret. Initially, the window displays the modules (<c>erl</c> + files) and subdirectories of the current working directory.</p> - <p>Interpretable modules are modules for which a BEAM file, compiled - with the option <c>debug_info</c> set, can be found in the same + <p>Interpretable modules are modules for which a <c>.beam</c> file, + compiled with option <c>debug_info</c> set, is located in the same directory as the source code, or in an <c>ebin</c> directory next to it.</p> - <p>Modules, for which the above requirements are not fulfilled, are - not interpretable and are therefore displayed within parentheses. - </p> + <p>Modules for which these requirements are not fulfilled are + not interpretable and are therefore displayed within parentheses.</p> - <p>The <c>debug_info</c> option causes <em>debug information</em> or - <em>abstract code</em> to be added to the BEAM file. This will - increase the size of the file, and also makes it possible to + <p>Option <c>debug_info</c> causes <em>debug information</em> or + <em>abstract code</em> to be added to the <c>.beam</c> file. + This increases the file size and makes it possible to reconstruct the source code. It is therefore recommended not to include debug information in code aimed for target systems.</p> <p>An example of how to compile code with debug information using - <c>erlc</c>:<br/> - <c>% erlc +debug_info module.erl</c></p> - + <c>erlc</c>:</p> + <pre> +% erlc +debug_info module.erl</pre> + <p>An example of how to compile code with debug information from - the Erlang shell:<br/> - <c>4> c(module, debug_info).</c></p> - + the Erlang shell:</p> + <pre> +4> c(module, debug_info).</pre> + <image file="images/interpret.jpg"> - <icaption>The Interpret Dialog Window.</icaption> + <icaption>Interpret Modules Window</icaption> </image> - <p>Browse the file hierarchy and interpret the appropriate modules - by selecting a module name and pressing <em>Choose</em> (or - carriage return), or by double clicking the module name. - Interpreted modules have the type <c>erl src</c>. - </p> + <p>To browse the file hierarchy and interpret the appropriate modules, + either select a module name and click <em>Choose</em> (or + press carriage return), or double-click the module name. + Interpreted modules have the type <c>erl src</c>.</p> - <p>Pressing <em>All</em> will interpret all displayed modules in - the chosen directory.</p> + <p>To interpret all displayed modules in the chosen directory, click + <em>All</em>.</p> - <p>Pressing <em>Done</em> will close the window.</p> + <p>To close the window, click <em>Done</em>.</p> <note> - <p>When the Debugger is started in global mode (which is - the default, see - <seealso marker="debugger:debugger#start/0">debugger:start/0</seealso>), - modules added (or deleted) for interpretation will be added (or - deleted) on all known Erlang nodes.</p> + <p>When Debugger is started in global mode (which is the default, see + <seealso marker="debugger#start/0">debugger:start/0</seealso>), + modules added (or deleted) for interpretation are added (or + deleted) on all known Erlang nodes.</p> </note> </section> <section> <marker id="attach"/> - <title>The Attach Process Window</title> + <title>Attach Process Window</title> - <p>From an Attach Process window the user can interact with a + <p>From an Attach Process window, you can interact with a debugged process. One window is opened for each process that has - been attached to. Note that when attaching to a process, its - execution is automatically stopped. - </p> + been attached to. Notice that when attaching to a process, its + execution is automatically stopped.</p> <image file="images/attach.jpg"> - <icaption>The Attach Process Window.</icaption> + <icaption>Attach Process Window</icaption> </image> - <p>The window is divided into five parts:</p> - <list> - <item><p>The Code area, showing the code being executed. The code - is indented and each line is prefixed with its line number. - If the process execution is stopped, the current line is - marked with <em>--></em>. An existing break point at a line - is marked with a stop symbol. In the example above, - the execution has been stopped at line 6, before - the execution of <c>fac/1</c>.</p> - <p>Active breakpoints are shown in red, while inactive - breakpoints are shown in blue.</p> + <p>The window is divided into the following five parts:</p> + <list type="bulleted"> + <item><p>The Code area, displaying the code being executed. The code + is indented and each line is prefixed with its line number. + If the process execution is stopped, the current line is + marked with <c>--></c>. An existing break point at a line + is marked with a stop symbol. In the example shown in the + illustration, the execution stopped at line 6, before + the execution of <c>fac/1</c>.</p> + + <p>Active breakpoints are displayed in red and inactive + breakpoints in blue.</p> </item> - <item>The Button area, with buttons for quick access to frequently - used functions in the Process menu.</item> - <item>The Evaluator area, where the user can evaluate functions - within the context of the debugged process, provided that - process execution has been stopped.</item> - <item>The Bindings area, showing all variables bindings. - Clicking on a variable name will result in the value being - displayed in the Evaluator area. - Double-clicking on a variable name will open a window where - the variable value may be edited. Note however that pid, - reference, binary or port values can not be edited. + + <item><p>The Button area, with buttons for quick access to frequently + used functions in the <em>Process</em> menu.</p></item> + + <item><p>The Evaluator area, where you can evaluate functions + within the context of the debugged process, if that + process execution is stopped.</p></item> + + <item><p>The Bindings area, displaying all variables bindings. If you + click a variable name, the value is displayed in the Evaluator area. + Double-click a variable name to open a window where + the variable value can be edited. Notice however that pid, + reference, binary, or port values cannot be edited.</p> </item> - <item><p>The Trace area, showing a trace output for the process. - </p> + + <item><p>The Trace area, which displays a trace output for the + process.</p> <taglist> - <tag><c>++ (N) <L></c></tag> - <item>Function call, where <c>N</c> is the call level and - <c>L</c> the line number.</item> + <tag><c>++ (N) <L></c></tag> + <item><p>Function call, where <c>N</c> is the call level and + <c>L</c> the line number.</p></item> - <tag><c>-- (N)</c></tag> - <item>Function return value.</item> + <tag><c>-- (N)</c></tag> + <item><p>Function return value</p>.</item> - <tag><c>==> Pid : Msg</c></tag> - <item>The message <c>Msg</c> is sent to process <c>Pid</c>. - </item> + <tag><c>==> Pid : Msg</c></tag> + <item><p>The message <c>Msg</c> is sent to process + <c>Pid</c>.</p></item> - <tag><c><![CDATA[<== Msg]]></c></tag> - <item>The message <c>Msg</c> is received.</item> + <tag><c><![CDATA[<== Msg]]></c></tag> + <item><p>The message <c>Msg</c> is received.</p></item> - <tag><c>++ (N) receive</c></tag> - <item>Waiting in a <c>receive</c>.</item> + <tag><c>++ (N) receive</c></tag> + <item><p>Waiting in a <c>receive</c>.</p></item> - <tag><c>++ (N) receive with timeout</c></tag> - <item>Waiting in a <c>receive...after</c>.</item> - </taglist> + <tag><c>++ (N) receive with timeout</c></tag> + <item><p>Waiting in a <c>receive...after</c>.</p></item> + </taglist> - <p>Also the back trace, a summary of the current function calls - on the stack, is displayed in the Trace area.</p> + <p>The Trace area also displays Back Trace, a summary of the + current function calls on the stack.</p> </item> </list> - <p>It is configurable using the Options menu which areas should - be shown or hidden. By default, all areas except the Trace area - are shown.</p> + <p>Using the <em>Options</em> menu, you can set which areas to be + displayed. By default, all areas except the Trace area are displayed.</p> <section> - <title>The File Menu</title> + <title>File Menu</title> <taglist> <tag><em>Close</em></tag> - <item><p>Close this window and detach from the process.</p> + <item><p>Closes this window and detach from the process.</p> </item> </taglist> </section> <section> - <title>The Edit Menu</title> + <title>Edit Menu</title> <taglist> <tag><em>Go to line...</em></tag> - <item><p>Go to a specified line number.</p></item> + <item><p>Goes to a specified line number.</p></item> <tag><em>Search...</em></tag> - <item><p>Search for a specified string.</p></item> + <item><p>Searches for a specified string.</p></item> </taglist> </section> <section> - <title>The Process Menu</title> + <title>Process Menu</title> <taglist> <tag><em>Step</em></tag> - <item><p>Execute the current line of code, stepping into any + <item><p>Executes the current code line, stepping into any (interpreted) function calls.</p></item> <tag><em>Next</em></tag> - <item><p>Execute the current line of code and stop at the next + <item><p>Executes the current code line and stop at the next line.</p></item> <tag><em>Continue</em></tag> - <item><p>Continue the execution.</p></item> + <item><p>Continues the execution.</p></item> <tag><em>Finish</em></tag> - <item><p>Continue the execution until the current function + <item><p>Continues the execution until the current function returns.</p></item> <tag><em>Skip</em></tag> - <item><p>Skip the current line of code and stop at the next + <item><p>Skips the current code line and stop at the next line. If used on the last line in a function body, - the function will return <c>skipped</c>.</p></item> + the function returns <c>skipped</c>.</p></item> <tag><em>Time Out</em></tag> - <item><p>Simulate a timeout when executing a + <item><p>Simulates a time-out when executing a <c>receive...after</c> statement.</p></item> <tag><em>Stop</em></tag> - <item><p>Stop the execution of a running process, that is, make - the process stop as at a breakpoint. The command will take + <item><p>Stops the execution of a running process, that is, make + the process stop at a breakpoint. The command takes effect (visibly) the next time the process receives a message.</p></item> <tag><em>Where</em></tag> - <item><p>Make sure the current location of the execution is + <item><p>Verifies that the current location of the execution is visible in the code area.</p></item> <tag><em>Kill</em></tag> - <item><p>Terminate the process using <c>exit(Pid,kill)</c>.</p> + <item><p>Terminates the process using <c>exit(Pid,kill)</c>.</p> </item> <tag><em>Messages</em></tag> - <item><p>Inspect the message queue of the process. The queue is - printed in the evaluator area.</p></item> + <item><p>Inspects the message queue of the process. The queue is + displayed in the Evaluator area.</p></item> <tag><em>Back Trace</em></tag> - <item><p>Display the back trace of the process, a summary of - the current function calls on the stack, in the trace area. - Requires that the Trace area is visible and that the stack - trace option is 'Stack On, Tail' or 'Stack On, No Tail'.</p> + <item><p>Displays the back trace of the process, a summary of + the current function calls on the stack, in the Trace area. + Requires that the Trace area is visible and that the Stack + Trace option is <em>Stack On, Tail</em> or + <em>Stack On, No Tail</em>.</p> </item> <tag><em>Up</em></tag> - <item><p>Inspect the previous function call on the stack, + <item><p>Inspects the previous function call on the stack, showing the location and variable bindings.</p></item> <tag><em>Down</em></tag> - <item><p>Inspect the next function call on the stack, showing + <item><p>Inspects the next function call on the stack, showing the location and variable bindings.</p></item> </taglist> </section> <section> - <title>The Options Menu</title> + <title>Options Menu</title> <taglist> <tag><em>Trace Window</em></tag> - <item><p>Set which areas should be visible. Does not affect - other Attach Process windows.</p> - </item> + <item><p>Sets which areas are to be visible. Does not affect + other Attach Process windows.</p></item> <tag><em>Stack Trace</em></tag> - <item><p>Same as in <seealso marker="#monitor">the Monitor - window</seealso>, but only affects the debugged - process the window is attached to.</p> - </item> + <item><p>Same as in the <seealso marker="#monitor">Monitor + window</seealso>, but only affects the debugged + process the window is attached to.</p></item> <tag><em>Strings</em></tag> - <item><p>Same as in <seealso marker="#monitor">the Monitor - window</seealso>, but only affects the debugged - process the window is attached to.</p> - </item> + <item><p>Same as in the <seealso marker="#monitor">Monitor + window</seealso>, but only affects the debugged + process the window is attached to.</p></item> <tag><em>Back Trace Size...</em></tag> - <item><p>Set how many call frames should be fetched when + <item><p>Sets how many call frames are to be fetched when inspecting the call stack. Does not affect other Attach - Process windows.</p> - </item> + Process windows.</p></item> </taglist> </section> <section> - <title>Break, Windows and Help Menus</title> + <title>Break, Windows, and Help Menus</title> - <p>The Break, Windows and Help menus look the same as in - the Monitor window, see the chapter - <seealso marker="#monitor">The Monitor Window</seealso>, except - that the Breaks menu apply to the local breakpoints only.</p> + <p>The <em>Break</em>, <em>Windows</em>, and <em>Help</em> menus + are the same as in the + <seealso marker="#monitor">Monitor Window</seealso>, except + that the <em>Breaks</em> menu applies only to local + breakpoints.</p> </section> </section> <section> <marker id="view"/> - <title>The View Module Window</title> + <title>View Module Window</title> - <p>The View Module window shows the contents of an interpreted + <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"> - <icaption>The View Module Window.</icaption> + <icaption>View Module Window</icaption> </image> <p>The source code is indented and each line is prefixed with its line number.</p> - <p>Clicking a line will highlight it and select it to be the target - of the breakpoint functions available from the Break menu. - Doubleclicking a line will set a line breakpoint on that line. - Doubleclicking a line with an existing breakpoint will remove - the breakpoint.</p> + <p>Clicking a line highlights it and selects it to be the target + of the breakpoint functions available from the <em>Break</em> menu. + To set a line breakpoint on a line, double-click it. + To remove the breakpoint, double-click the line with an existing + breakpoint.</p> <p>Breakpoints are marked with a stop symbol.</p> <section> <title>File and Edit Menus</title> - <p>The File and Edit menus look the same as in the Attach Process - window, see the chapter <seealso marker="#attach">The Attach - Process Window</seealso>.</p> + <p>The <em>File</em> and <em>Edit</em> menus are the same as in the + <seealso marker="#attach">Attach Process Window</seealso>.</p> </section> <section> - <title>Break, Windows and Help Menus</title> + <title>Break, Windows, and Help Menus</title> - <p>The Break, Windows and Help menus look the same as in - the Monitor window, see the chapter - <seealso marker="#monitor">The Monitor Window</seealso>, except - that the Breaks menu apply to the local breakpoints only.</p> + <p>The <em>Break</em>, <em>Windows</em>, and <em>Help</em> menus + are the same as in the + <seealso marker="#monitor">Monitor Window</seealso>, except + that the <em>Break</em> menu applies only to local breakpoints.</p> </section> </section> @@ -862,14 +852,14 @@ c_break(Bindings) -> <title>Performance</title> <p>Execution of interpreted code is naturally slower than for - regularly compiled modules. Using the Debugger also increases + regularly compiled modules. Using Debugger also increases the number of processes in the system, as for each debugged process another process (the meta process) is created.</p> - <p>It is also worth to keep in mind that programs with timers may + <p>It is also worth to keep in mind that programs with timers can behave differently when debugged. This is especially true when - stopping the execution of a process, for example at a - breakpoint. Timeouts can then occur in other processes that + stopping the execution of a process (for example, at a + breakpoint). Time-outs can then occur in other processes that continue execution as normal.</p> </section> @@ -878,8 +868,8 @@ c_break(Bindings) -> <p>Code loading works almost as usual, except that interpreted modules are also stored in a database and debugged processes - uses only this stored code. Re-interpreting an interpreted - module will result in the new version being stored as well, but + use only this stored code. Reinterpreting an interpreted + module results in the new version being stored as well, but does not affect existing processes executing an older version of the code. This means that the code replacement mechanism of Erlang does not work for debugged processes.</p> @@ -888,22 +878,24 @@ c_break(Bindings) -> <section> <title>Debugging Remote Nodes</title> - <p>By using <c>debugger:start/1</c>, it can be specified if Debugger - should be started in local or global mode.</p> + <p>By using + <seealso marker="debugger#start/1">debugger:start/1</seealso>, + you can specify if Debugger is to be started in local or global + mode:</p> <pre> debugger:start(local | global)</pre> - <p>If no argument is provided, Debugger is started in global mode. - </p> + + <p>If no argument is provided, Debugger starts in global mode.</p> <p>In local mode, code is interpreted only at the current node. In global mode, code is interpreted at all known nodes. Processes - at other nodes executing interpreted code will automatically be - shown in the Monitor window and can be attached to like any other + at other nodes executing interpreted code are automatically + displayed in the Monitor window and can be attached to like any other debugged process.</p> - <p>It is possible, but definitely not recommended to start Debugger - in global mode on more than one node in a network, as they will - interfere with each other leading to inconsistent behaviour.</p> + <p>It is possible, but definitely not recommended, to start Debugger + in global mode on more than one node in a network, as the nodes + interfere with each other, leading to inconsistent behavior.</p> </section> </chapter> diff --git a/lib/debugger/doc/src/i.xml b/lib/debugger/doc/src/i.xml index 9ceba94b44..db89f23494 100644 --- a/lib/debugger/doc/src/i.xml +++ b/lib/debugger/doc/src/i.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1998</year><year>2013</year> + <year>1998</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -29,35 +29,36 @@ <rev></rev> </header> <module>i</module> - <modulesummary>Debugger/Interpreter Interface</modulesummary> + <modulesummary>Debugger/Interpreter Interface.</modulesummary> <description> - <p>The module <c>i</c> provides short forms for some of + <p>The <c>i</c> module provides short forms for some of the functions used by the graphical Debugger and some of - the functions in the <c>int</c> module, the Erlang interpreter. - </p> + the functions in module + <seealso marker="int"><c>int</c></seealso>, the Erlang interpreter.</p> <p>This module also provides facilities for displaying status information about interpreted processes and break points.</p> <p>It is possible to attach to interpreted processes by giving the corresponding process identity only. By default, an attachment - window pops up. Processes at other Erlang nodes can be + window is displayed. Processes at other Erlang nodes can be attached manually or automatically.</p> - <p>By preference, these functions can be included in the module - <c>shell_default</c>. By default, they are.</p> + <p>By preference, these functions can be included in module + <seealso marker="stdlib:shell_default"><c>stdlib:shell_default</c></seealso>. + By default, they are included in that module.</p> </description> <funcs> <func> <name>im() -> pid()</name> - <fsummary>Start a graphical monitor</fsummary> + <fsummary>Start a graphical monitor.</fsummary> <desc> <p>Starts a new graphical monitor. This is the Monitor window, - the main window of the Debugger. All of the Debugger and + the main window of Debugger. All the Debugger and interpreter functionality is accessed from the Monitor window. - The Monitor window displays the status of all processes that - have been/are executing interpreted modules.</p> + This window displays the status of all processes that + have been or are executing interpreted modules.</p> </desc> </func> @@ -66,7 +67,7 @@ <name>ii(AbsModule) -> {module, Module} | error</name> <name>ini(AbsModules) -> ok</name> <name>ini(AbsModule) -> {module, Module} | error</name> - <fsummary>Interpret a module</fsummary> + <fsummary>Interpret a module.</fsummary> <type> <v>AbsModules = [AbsModule]</v> <v>AbsModule = Module | File</v> @@ -85,7 +86,7 @@ <func> <name>iq(AbsModule) -> ok</name> <name>inq(AbsModule) -> ok</name> - <fsummary>Stop interpreting a module</fsummary> + <fsummary>Stop interpreting a module.</fsummary> <type> <v>AbsModule = Module | File</v> <v> Module = atom()</v> @@ -110,28 +111,27 @@ <func> <name>ip() -> ok</name> - <fsummary>Make a printout of the current status of all interpreted - processes</fsummary> + <fsummary>Print the current status of all interpreted + processes.</fsummary> <desc> - <p>Makes a printout of the current status of all interpreted - processes.</p> + <p>Prints the current status of all interpreted processes.</p> </desc> </func> <func> <name>ic() -> ok</name> <fsummary>Clear information about processes executing interpreted - code</fsummary> + code.</fsummary> <desc> <p>Clears information about processes executing interpreted code - byt removing all information about terminated processes.</p> + by removing all information about terminated processes.</p> </desc> </func> <func> <name>iaa(Flags) -> true</name> <name>iaa(Flags, Function) -> true</name> - <fsummary>Set when and how to attach to a process</fsummary> + <fsummary>Set when and how to attach to a process.</fsummary> <type> <v>Flags = [init | break | exit]</v> <v>Function = {Module,Name,Args}</v> @@ -139,42 +139,41 @@ <v> Args = [term()]</v> </type> <desc> - <p>Sets when and how to automatically attach to a debugged - process, see + <p>Sets when and how to attach to a debugged process + automatically, see <seealso marker="int#auto_attach/0">int:auto_attach/2</seealso>. <c>Function</c> defaults to the standard function used by - the Debugger.</p> + Debugger.</p> </desc> </func> <func> <name>ist(Flag) -> true</name> - <fsummary>Set how to save call frames</fsummary> + <fsummary>Set how to save call frames.</fsummary> <type> <v>Flag = all | no_tail | false</v> </type> <desc> <p>Sets how to save call frames in the stack, see - <seealso marker="int#stack_trace/0">int:stack_trace/1</seealso>. - </p> + <seealso marker="int#stack_trace/0">int:stack_trace/1</seealso>.</p> </desc> </func> <func> <name>ia(Pid) -> ok | no_proc</name> - <fsummary>Attach to a process</fsummary> + <fsummary>Attache to a process.</fsummary> <type> <v>Pid = pid()</v> </type> <desc> - <p>Attaches to the debugged process <c>Pid</c>. A Debugger + <p>Attaches to the debugged process <c>Pid</c>. An Attach Process window is opened for the process.</p> </desc> </func> <func> <name>ia(X,Y,Z) -> ok | no_proc</name> - <fsummary>Attach to a process</fsummary> + <fsummary>Attache to a process.</fsummary> <type> <v>X = Y = Z = int()</v> </type> @@ -186,7 +185,7 @@ <func> <name>ia(Pid, Function) -> ok | no_proc</name> - <fsummary>Attach to a process</fsummary> + <fsummary>Attache to a process.</fsummary> <type> <v>Pid = pid()</v> <v>Function = {Module,Name}</v> @@ -194,14 +193,14 @@ </type> <desc> <p>Attaches to the debugged process <c>Pid</c>. The interpreter - will call <c>spawn(Module, Name, [Pid])</c> (and ignore + calls <c>spawn(Module, Name, [Pid])</c> (and ignores the result).</p> </desc> </func> <func> <name>ia(X,Y,Z, Function) -> ok | no_proc</name> - <fsummary>Attach to a process</fsummary> + <fsummary>Attache to a process.</fsummary> <type> <v>X = Y = Z = int()</v> <v>Function = {Module,Name}</v> @@ -211,15 +210,15 @@ <p>Same as <c>ia(Pid, Function)</c>, where <c>Pid</c> is the result of calling the shell function <c>pid(X,Y,Z)</c>. An attached process is expected to call the unofficial - <c>int:attached(Pid)</c> function and to be able to handle - messages from the interpreter, see <c>dbg_wx_trace.erl</c> for - an example.</p> + function <c>int:attached(Pid)</c> and to be able to handle + messages from the interpreter. For an example, see + <c>dbg_wx_trace.erl</c>.</p> </desc> </func> <func> <name>ib(Module, Line) -> ok | {error, break_exists}</name> - <fsummary>Create a breakpoint</fsummary> + <fsummary>Create a breakpoint.</fsummary> <type> <v>Module = atom()</v> <v>Line = int()</v> @@ -232,20 +231,20 @@ <func> <name>ib(Module, Name, Arity) -> ok | {error, function_not_found} </name> - <fsummary>Create breakpoints in the specified function</fsummary> + <fsummary>Create breakpoints in the specified function.</fsummary> <type> <v>Module = Name = atom()</v> <v>Arity = int()</v> </type> <desc> <p>Creates breakpoints at the first line of every clause of - the <c>Module:Name/Arity</c> function.</p> + function <c>Module:Name/Arity</c>.</p> </desc> </func> <func> <name>ir() -> ok</name> - <fsummary>Delete all breakpoints</fsummary> + <fsummary>Delete all breakpoints.</fsummary> <desc> <p>Deletes all breakpoints.</p> </desc> @@ -253,7 +252,7 @@ <func> <name>ir(Module) -> ok</name> - <fsummary>Delete all breakpoints in a module</fsummary> + <fsummary>Delete all breakpoints in a module.</fsummary> <type> <v>Module = atom()</v> </type> @@ -264,61 +263,57 @@ <func> <name>ir(Module, Line) -> ok</name> - <fsummary>Delete a breakpoint</fsummary> + <fsummary>Delete a breakpoint.</fsummary> <type> <v>Module = atom()</v> <v>Line = int()</v> </type> <desc> - <p>Deletes the breakpoint located at <c>Line</c> in - <c>Module</c>.</p> + <p>Deletes the breakpoint at <c>Line</c> in <c>Module</c>.</p> </desc> </func> <func> <name>ir(Module, Name, Arity) -> ok | {error, function_not_found} </name> - <fsummary>Delete breakpoints from the specified function - </fsummary> + <fsummary>Delete breakpoints from the specified function.</fsummary> <type> <v>Module = Name = atom()</v> <v>Arity = int()</v> </type> <desc> <p>Deletes the breakpoints at the first line of every clause of - the <c>Module:Name/Arity</c> function.</p> + function <c>Module:Name/Arity</c>.</p> </desc> </func> <func> <name>ibd(Module, Line) -> ok</name> - <fsummary>Make a breakpoint inactive</fsummary> + <fsummary>Make a breakpoint inactive.</fsummary> <type> <v>Module = atom()</v> <v>Line = int()</v> </type> <desc> - <p>Makes the breakpoint at <c>Line</c> in <c>Module</c> - inactive.</p> + <p>Makes the breakpoint at <c>Line</c> in <c>Module</c> inactive.</p> </desc> </func> <func> <name>ibe(Module, Line) -> ok</name> - <fsummary>Make a breakpoint active</fsummary> + <fsummary>Make a breakpoint active.</fsummary> <type> <v>Module = atom()</v> <v>Line = int()</v> </type> <desc> - <p>Makes the breakpoint at <c>Line</c> in <c>Module</c> active. - </p> + <p>Makes the breakpoint at <c>Line</c> in <c>Module</c> active.</p> </desc> </func> <func> <name>iba(Module, Line, Action) -> ok</name> - <fsummary>Set the trigger action of a breakpoint</fsummary> + <fsummary>Set the trigger action of a breakpoint.</fsummary> <type> <v>Module = atom()</v> <v>Line = int()</v> @@ -332,7 +327,7 @@ <func> <name>ibc(Module, Line, Function) -> ok</name> - <fsummary>Set the conditional test of a breakpoint</fsummary> + <fsummary>Set the conditional test of a breakpoint.</fsummary> <type> <v>Module = atom()</v> <v>Line = int()</v> @@ -346,46 +341,44 @@ <p>The conditional test is performed by calling <c>Module:Name(Bindings)</c>, where <c>Bindings</c> is the current variable bindings. The function must return - <c>true</c> (break) or <c>false</c> (do not break). Use - <c>int:get_binding(Var, Bindings)</c> to retrieve the value - of a variable <c>Var</c>.</p> + <c>true</c> (break) or <c>false</c> (do not break). + To retrieve the value of a variable <c>Var</c>, use + <seealso marker="int#get_binding/2">int:get_binding(Var, Bindings)</seealso>.</p> </desc> </func> <func> <name>ipb() -> ok</name> - <fsummary>Make a printout of all existing breakpoints</fsummary> + <fsummary>Print all existing breakpoints.</fsummary> <desc> - <p>Makes a printout of all existing breakpoints.</p> + <p>Prints all existing breakpoints.</p> </desc> </func> <func> <name>ipb(Module) -> ok</name> - <fsummary>Make a printout of all breakpoints in a module - </fsummary> + <fsummary>Print all existing breakpoints in a module.</fsummary> <type> <v>Module = atom()</v> </type> <desc> - <p>Makes a printout of all existing breakpoints in - <c>Module</c>.</p> + <p>Prints all existing breakpoints in <c>Module</c>.</p> </desc> </func> <func> <name>iv() -> atom()</name> - <fsummary>Current version number of the interpreter</fsummary> + <fsummary>Return the current version number of the interpreter. + </fsummary> <desc> <p>Returns the current version number of the interpreter. - The same as the version number of the Debugger application. - </p> + Same as the version number of the <c>Debugger</c> application.</p> </desc> </func> <func> <name>help() -> ok</name> - <fsummary>Print help text</fsummary> + <fsummary>Print help text.</fsummary> <desc> <p>Prints help text.</p> </desc> @@ -393,15 +386,8 @@ </funcs> <section> - <title>Usage</title> - - <p>Refer to the Debugger User's Guide for information about - the Debugger.</p> - </section> - - <section> <title>See Also</title> - <p><c>int(3)</c></p> + <p><seealso marker="int"><c>int(3)</c></seealso></p> </section> </erlref> diff --git a/lib/debugger/doc/src/int.xml b/lib/debugger/doc/src/int.xml index ea21d04a07..31e9dfe923 100644 --- a/lib/debugger/doc/src/int.xml +++ b/lib/debugger/doc/src/int.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1998</year><year>2013</year> + <year>1998</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -29,16 +29,16 @@ <rev></rev> </header> <module>int</module> - <modulesummary>Interpreter Interface</modulesummary> + <modulesummary>Interpreter Interface.</modulesummary> <description> <p>The Erlang interpreter provides mechanisms for breakpoints and - stepwise execution of code. It is mainly intended to be used by - the <em>Debugger</em>, see Debugger User's Guide and - <c>debugger(3)</c>.</p> + stepwise execution of code. It is primarily intended to be used by + Debugger, see the User's Guide and + <seealso marker="debugger"><c>debugger(3)</c></seealso>.</p> - <p>From the shell, it is possible to:</p> - <list> - <item>Specify which modules should be interpreted.</item> + <p>The following can be done from the shell:</p> + <list type="bulleted"> + <item>Specify the modules to be interpreted.</item> <item>Specify breakpoints.</item> <item>Monitor the current status of all processes executing code in interpreted modules, also processes at other Erlang nodes. @@ -48,45 +48,48 @@ <p>By <em>attaching to</em> a process executing interpreted code, it is possible to examine variable bindings and order stepwise execution. This is done by sending and receiving information - to/from the process via a third process, called the meta process. - It is possible to implement your own attached process. See + to/from the process through a third process, called the meta + process. You can implement your own attached process. See <c>int.erl</c> for available functions and <c>dbg_wx_trace.erl</c> for possible messages.</p> - <p>The interpreter depends on the Kernel, STDLIB and GS - applications, which means modules belonging to any of these - applications are not allowed to be interpreted as it could lead + <p>The interpreter depends on the Kernel, STDLIB, and + GS applications. This means that modules belonging to any of + these applications are not allowed to be interpreted, as it could lead to a deadlock or emulator crash. This also applies to modules - belonging to the Debugger application itself.</p> + belonging to the Debugger application.</p> </description> <section> + <marker id="int_breakpoints"/> <title>Breakpoints</title> <p>Breakpoints are specified on a line basis. When a process executing code in an interpreted module reaches a breakpoint, it - will stop. This means that that a breakpoint must be set at an - executable line, that is, a line of code containing an executable + stops. This means that a breakpoint must be set at an + executable line, that is, a code line containing an executable expression.</p> - <p>A breakpoint have a status, a trigger action and may have a - condition associated with it. The status is either <em>active</em> - or <em>inactive</em>. An inactive breakpoint is ignored. When a - breakpoint is reached, the trigger action specifies if - the breakpoint should continue to be active (<em>enable</em>), if - it should become inactive (<em>disable</em>), or if it should be - removed (<em>delete</em>). A condition is a tuple - <c>{Module,Name}</c>. When the breakpoint is reached, - <c>Module:Name(Bindings)</c> is called. If this evaluates to - <c>true</c>, execution will stop. If this evaluates to - <c>false</c>, the breakpoint is ignored. <c>Bindings</c> contains - the current variable bindings, use <c>get_binding</c> to retrieve - the value for a given variable.</p> + <p>A breakpoint has the following:</p> + <list type="bulleted"> + <item>A status, which is <em>active</em> or <em>inactive</em>. An + inactive breakpoint is ignored.</item> + <item>A trigger action. When a breakpoint is reached, the trigger + action specifies if the breakpoint is to continue as active + (<em>enable</em>), or to become inactive (<em>disable</em>), or + to be removed (<em>delete</em>).</item> + <item>Optionally an associated condition. A condition is a tuple + <c>{Module,Name}</c>. When the breakpoint is reached, + <c>Module:Name(Bindings)</c> is called. If it evaluates to + <c>true</c>, execution stops. If it evaluates to <c>false</c>, + the breakpoint is ignored. <c>Bindings</c> contains the current + variable bindings. To retrieve the value for a specified variable, + use <c>get_binding</c>.</item> + </list> <p>By default, a breakpoint is active, has trigger action - <c>enable</c> and has no condition associated with it. For more - detailed information about breakpoints, refer to Debugger User's - Guide.</p> + <c>enable</c>, and has no associated condition. For details + about breakpoints, see the User's Guide.</p> </section> <funcs> @@ -95,7 +98,7 @@ <name>i(AbsModules) -> ok</name> <name>ni(AbsModule) -> {module,Module} | error</name> <name>ni(AbsModules) -> ok</name> - <fsummary>Interpret a module</fsummary> + <fsummary>Interpret a module.</fsummary> <type> <v>AbsModules = [AbsModule]</v> <v>AbsModule = Module | File | [Module | File]</v> @@ -107,41 +110,43 @@ the module only at the current node. <c>ni/1</c> interprets the module at all known nodes.</p> - <p>A module may be given by its module name (atom) or by its - file name. If given by its module name, the object code + <p>A module can be specified by its module name (atom) or + filename.</p> + + <p>If specified by its module name, the object code <c>Module.beam</c> is searched for in the current path. The source code <c>Module.erl</c> is searched for first in - the same directory as the object code, then in a <c>src</c> + the same directory as the object code, then in an <c>src</c> directory next to it.</p> - <p>If given by its file name, the file name may include a path - and the <c>.erl</c> extension may be omitted. The object code + <p>If specified by its filename, the filename can include a path + and the <c>.erl</c> extension can be omitted. The object code <c>Module.beam</c> is searched for first in the same directory as the source code, then in an <c>ebin</c> directory next to it, and then in the current path.</p> <note> - <p>The interpreter needs both the source code and the object - code, and the object code <em>must</em> include debug - information. That is, only modules compiled with the option + <p>The interpreter requires both the source code and the object + code. The object code <em>must</em> include debug + information, that is, only modules compiled with option <c>debug_info</c> set can be interpreted.</p> </note> <p>The functions returns <c>{module,Module}</c> if the module - was interpreted, or <c>error</c> if it was not.</p> + was interpreted, otherwise <c>error</c> is returned.</p> - <p>The argument may also be a list of modules/file names, in + <p>The argument can also be a list of modules or filenames, in which case the function tries to interpret each module as - specified above. The function then always returns <c>ok</c>, - but prints some information to stdout if a module could not be - interpreted.</p> + specified earlier. The function then always returns <c>ok</c>, + but prints some information to <c>stdout</c> if a module + cannot be interpreted.</p> </desc> </func> <func> <name>n(AbsModule) -> ok</name> <name>nn(AbsModule) -> ok</name> - <fsummary>Stop interpreting a module</fsummary> + <fsummary>Stop interpreting a module.</fsummary> <type> <v>AbsModule = Module | File | [Module | File]</v> <v> Module = atom()</v> @@ -152,14 +157,14 @@ interpreting the module only at the current node. <c>nn/1</c> stops interpreting the module at all known nodes.</p> - <p>As for <c>i/1</c> and <c>ni/1</c>, a module may be given by - either its module name or its file name.</p> + <p>As for <c>i/1</c> and <c>ni/1</c>, a module can be specified by + its module name or filename.</p> </desc> </func> <func> <name>interpreted() -> [Module]</name> - <fsummary>Get all interpreted modules</fsummary> + <fsummary>Get all interpreted modules.</fsummary> <type> <v>Module = atom()</v> </type> @@ -170,20 +175,20 @@ <func> <name>file(Module) -> File | {error,not_loaded}</name> - <fsummary>Get the file name for an interpreted module</fsummary> + <fsummary>Get the filename for an interpreted module.</fsummary> <type> <v>Module = atom()</v> <v>File = string()</v> </type> <desc> - <p>Returns the source code file name <c>File</c> for an + <p>Returns the source code filename <c>File</c> for an interpreted module <c>Module</c>.</p> </desc> </func> <func> <name>interpretable(AbsModule) -> true | {error,Reason}</name> - <fsummary>Check if a module is possible to interpret</fsummary> + <fsummary>Check if a module can be interpreted.</fsummary> <type> <v>AbsModule = Module | File</v> <v> Module = atom()</v> @@ -193,45 +198,59 @@ <v> App = atom()</v> </type> <desc> - <p>Checks if a module is possible to interpret. The module can - be given by its module name <c>Module</c> or its source file - name <c>File</c>. If given by a module name, the module is - searched for in the code path.</p> - - <p>The function returns <c>true</c> if both source code and - object code for the module is found, the module has been - compiled with the option <c>debug_info</c> set and does not - belong to any of the applications Kernel, STDLIB, GS or - Debugger itself.</p> - - <p>The function returns <c>{error,Reason}</c> if the module for - some reason is not possible to interpret.</p> - - <p><c>Reason</c> is <c>no_src</c> if no source code is found or - <c>no_beam</c> if no object code is found. It is assumed that - the source- and object code are located either in the same - directory, or in <c>src</c> and <c>ebin</c> directories next - to each other.</p> - - <p><c>Reason</c> is <c>no_debug_info</c> if the module has not - been compiled with the option <c>debug_info</c> set.</p> - - <p><c>Reason</c> is <c>badarg</c> if <c>AbsModule</c> is not - found. This could be because the specified file does not - exist, or because <c>code:which/1</c> does not return a - beam file name, which is the case not only for non-existing - modules but also for modules which are preloaded or cover - compiled.</p> - - <p><c>Reason</c> is <c>{app,App}</c> where <c>App</c> is - <c>kernel</c>, <c>stdlib</c>, <c>gs</c> or <c>debugger</c> if - <c>AbsModule</c> belongs to one of these applications.</p> - - <p>Note that the function can return <c>true</c> for a module - which in fact is not interpretable in the case where + <p>Checks if a module can be interpreted. The module can be + specified by its module name <c>Module</c> or its source + filename <c>File</c>. If specified by a module name, the module + is searched for in the code path.</p> + + <p>The function returns <c>true</c> if all of the following + apply:</p> + <list type="bulleted"> + <item>Both source code and object code for the module is + found.</item> + <item>The module has been compiled with option <c>debug_info</c> + set.</item> + <item>The module does not belong to any of the applications + Kernel, STDLIB, GS, or Debugger.</item> + </list> + + <p>The function returns <c>{error,Reason}</c> if the module cannot + be interpreted. <c>Reason</c> can have the following values:</p> + <taglist> + <tag><c>no_src</c></tag> + <item><p>No source code is found. + It is assumed that the source code and object code are located + either in the same directory, or in <c>src</c> and <c>ebin</c> + directories next to each other.</p></item> + + <tag><c>no_beam</c></tag> + <item><p>No object code is found. + It is assumed that the source code and object code are located + either in the same directory, or in <c>src</c> and <c>ebin</c> + directories next to each other.</p></item> + + <tag><c>no_debug_info</c></tag> + <item><p>The module has not been compiled with option + <c>debug_info</c> set.</p></item> + + <tag><c>badarg</c></tag> + <item><p><c>AbsModule</c> is not found. This could be because + the specified file does not exist, or because + <c>code:which/1</c> does not return a BEAM filename, + which is the case not only for non-existing modules but also + for modules that are preloaded or cover-compiled.</p></item> + + <tag><c>{app,App}</c></tag> + <item><p><c>App</c> is <c>kernel</c>, <c>stdlib</c>, <c>gs</c>, + or <c>debugger</c> if <c>AbsModule</c> belongs to one of these + applications.</p></item> + </taglist> + + <p>Notice that the function can return <c>true</c> for a module + that in fact is not interpretable in the case where the module is marked as sticky or resides in a directory - marked as sticky, as this is not discovered until - the interpreter actually tries to load the module.</p> + marked as sticky. The reason is that this is not discovered + until the interpreter tries to load the module.</p> </desc> </func> @@ -239,7 +258,7 @@ <name>auto_attach() -> false | {Flags,Function}</name> <name>auto_attach(false)</name> <name>auto_attach(Flags, Function)</name> - <fsummary>Get/set when and how to attach to a process</fsummary> + <fsummary>Get and set when and how to attach to a process.</fsummary> <type> <v>Flags = [init | break | exit]</v> <v>Function = {Module,Name,Args}</v> @@ -247,24 +266,24 @@ <v> Args = [term()]</v> </type> <desc> - <p>Gets and sets when and how to automatically attach to a + <p>Gets and sets when and how to attach automatically to a process executing code in interpreted modules. <c>false</c> - means never automatically attach, this is the default. + means never attach automatically, this is the default. Otherwise automatic attach is defined by a list of flags and - a function. The following flags may be specified:</p> - <list> - <item><c>init</c> - attach when a process for the very first + a function. The following flags can be specified:</p> + <list type="bulleted"> + <item><c>init</c> - Attach when a process for the first time calls an interpreted function.</item> - <item><c>break</c> - attach whenever a process reaches a + <item><c>break</c> - Attach whenever a process reaches a breakpoint.</item> - <item><c>exit</c> - attach when a process terminates.</item> + <item><c>exit</c> - Attach when a process terminates.</item> </list> <p>When the specified event occurs, the function <c>Function</c> - will be called as:</p> + is called as:</p> <pre> -spawn(Module, Name, [Pid | Args]) - </pre> +spawn(Module, Name, [Pid | Args])</pre> + <p><c>Pid</c> is the pid of the process executing interpreted code.</p> </desc> @@ -273,7 +292,7 @@ spawn(Module, Name, [Pid | Args]) <func> <name>stack_trace() -> Flag</name> <name>stack_trace(Flag)</name> - <fsummary>Get/set if and how to save call frames</fsummary> + <fsummary>Get and set if and how to save call frames.</fsummary> <type> <v>Flag = all | no_tail | false</v> </type> @@ -281,25 +300,30 @@ spawn(Module, Name, [Pid | Args]) <p>Gets and sets how to save call frames in the stack. Saving call frames makes it possible to inspect the call chain of a process, and is also used to emulate the stack trace if an - error (an exception of class error) occurs.</p> - <list> - <item><c>all</c> - save information about all current calls, - that is, function calls that have not yet returned a value. - </item> - <item><c>no_tail</c> - save information about current calls, + error (an exception of class error) occurs. The following + flags can be specified:</p> + <taglist> + <tag><c>all</c></tag> + <item><p>Save information about all current calls, + that is, function calls that have not yet returned a value.</p> + </item> + + <tag><c>no_tail</c></tag> + <item><p>Save information about current calls, but discard previous information when a tail recursive call - is made. This option consumes less memory and may be + is made. This option consumes less memory and can be necessary to use for processes with long lifetimes and many - tail recursive calls. This is the default.</item> - <item><c>false</c> - do not save any information about current - calls.</item> - </list> + tail recursive calls. This is the default.</p></item> + + <tag><c>false</c></tag> + <item><p>Save no information about currentcalls.</p></item> + </taglist> </desc> </func> <func> <name>break(Module, Line) -> ok | {error,break_exists}</name> - <fsummary>Create a breakpoint</fsummary> + <fsummary>Create a breakpoint.</fsummary> <type> <v>Module = atom()</v> <v>Line = int()</v> @@ -311,86 +335,80 @@ spawn(Module, Name, [Pid | Args]) <func> <name>delete_break(Module, Line) -> ok</name> - <fsummary>Delete a breakpoint</fsummary> + <fsummary>Delete a breakpoint.</fsummary> <type> <v>Module = atom()</v> <v>Line = int()</v> </type> <desc> - <p>Deletes the breakpoint located at <c>Line</c> in - <c>Module</c>.</p> + <p>Deletes the breakpoint at <c>Line</c> in <c>Module</c>.</p> </desc> </func> <func> <name>break_in(Module, Name, Arity) -> ok | {error,function_not_found}</name> - <fsummary>Create breakpoints in the specified function</fsummary> + <fsummary>Create breakpoints in the specified function.</fsummary> <type> <v>Module = Name = atom()</v> <v>Arity = int()</v> </type> <desc> <p>Creates a breakpoint at the first line of every clause of - the <c>Module:Name/Arity</c> function.</p> + function <c>Module:Name/Arity</c>.</p> </desc> </func> <func> <name>del_break_in(Module, Name, Arity) -> ok | {error,function_not_found}</name> - <fsummary>Delete breakpoints from the specified function - </fsummary> + <fsummary>Delete breakpoints from the specified function.</fsummary> <type> <v>Module = Name = atom()</v> <v>Arity = int()</v> </type> <desc> <p>Deletes the breakpoints at the first line of every clause of - the <c>Module:Name/Arity</c> function. - </p> + function <c>Module:Name/Arity</c>.</p> </desc> </func> <func> <name>no_break() -> ok</name> <name>no_break(Module) -> ok</name> - <fsummary>Delete all breakpoints</fsummary> + <fsummary>Delete all breakpoints.</fsummary> <desc> - <p>Deletes all breakpoints, or all breakpoints in <c>Module</c>. - </p> + <p>Deletes all breakpoints, or all breakpoints in <c>Module</c>.</p> </desc> </func> <func> <name>disable_break(Module, Line) -> ok</name> - <fsummary>Make a breakpoint inactive</fsummary> + <fsummary>Make a breakpoint inactive.</fsummary> <type> <v>Module = atom()</v> <v>Line = int()</v> </type> <desc> - <p>Makes the breakpoint at <c>Line</c> in <c>Module</c> - inactive.</p> + <p>Makes the breakpoint at <c>Line</c> in <c>Module</c> inactive.</p> </desc> </func> <func> <name>enable_break(Module, Line) -> ok</name> - <fsummary>Make a breakpoint active</fsummary> + <fsummary>Make a breakpoint active.</fsummary> <type> <v>Module = atom()</v> <v>Line = int()</v> </type> <desc> - <p>Makes the breakpoint at <c>Line</c> in <c>Module</c> active. - </p> + <p>Makes the breakpoint at <c>Line</c> in <c>Module</c> active.</p> </desc> </func> <func> <name>action_at_break(Module, Line, Action) -> ok</name> - <fsummary>Set the trigger action of a breakpoint</fsummary> + <fsummary>Set the trigger action of a breakpoint.</fsummary> <type> <v>Module = atom()</v> <v>Line = int()</v> @@ -404,7 +422,7 @@ spawn(Module, Name, [Pid | Args]) <func> <name>test_at_break(Module, Line, Function) -> ok</name> - <fsummary>Set the conditional test of a breakpoint</fsummary> + <fsummary>Set the conditional test of a breakpoint.</fsummary> <type> <v>Module = atom()</v> <v>Line = int()</v> @@ -414,14 +432,14 @@ spawn(Module, Name, [Pid | Args]) <desc> <p>Sets the conditional test of the breakpoint at <c>Line</c> in <c>Module</c> to <c>Function</c>. The function must - fulfill the requirements specified in the section - <em>Breakpoints</em> above.</p> + fulfill the requirements specified in section + <seealso marker="#int_breakpoints">Breakpoints</seealso>.</p> </desc> </func> <func> <name>get_binding(Var, Bindings) -> {value,Value} | unbound</name> - <fsummary>Retrieve a variable binding</fsummary> + <fsummary>Retrieve a variable binding.</fsummary> <type> <v>Var = atom()</v> <v>Bindings = term()</v> @@ -437,7 +455,7 @@ spawn(Module, Name, [Pid | Args]) <func> <name>all_breaks() -> [Break]</name> <name>all_breaks(Module) -> [Break]</name> - <fsummary>Get all breakpoints</fsummary> + <fsummary>Get all breakpoints.</fsummary> <type> <v>Break = {Point,Options}</v> <v> Point = {Module,Line}</v> @@ -451,15 +469,14 @@ spawn(Module, Name, [Pid | Args]) <v> Name = atom()</v> </type> <desc> - <p>Gets all breakpoints, or all breakpoints in <c>Module</c>. - </p> + <p>Gets all breakpoints, or all breakpoints in <c>Module</c>.</p> </desc> </func> <func> <name>snapshot() -> [Snapshot]</name> <fsummary>Get information about all processes executing interpreted - code</fsummary> + code.</fsummary> <type> <v>Snapshot = {Pid, Function, Status, Info}</v> <v> Pid = pid()</v> @@ -475,26 +492,27 @@ spawn(Module, Name, [Pid | Args]) <desc> <p>Gets information about all processes executing interpreted code. </p> - <list> - <item><c>Pid</c> - process identifier.</item> - <item><c>Function</c> - first interpreted function called by + <list type="bulleted"> + <item><c>Pid</c> - Process identifier.</item> + <item><c>Function</c> - First interpreted function called by the process.</item> - <item><c>Status</c> - current status of the process.</item> - <item><c>Info</c> - additional information.</item> + <item><c>Status</c> - Current status of the process.</item> + <item><c>Info</c> - More information.</item> </list> - <p><c>Status</c> is one of:</p> - <list> - <item><c>idle</c> - the process is no longer executing + + <p><c>Status</c> is one of the following:</p> + <list type="bulleted"> + <item><c>idle</c> - The process is no longer executing interpreted code. <c>Info={}</c>.</item> - <item><c>running</c> - the process is running. <c>Info={}</c>. + <item><c>running</c> - The process is running. <c>Info={}</c>. </item> - <item><c>waiting</c> - the process is waiting at a + <item><c>waiting</c> - The process is waiting at a <c>receive</c>. <c>Info={}</c>.</item> - <item><c>break</c> - process execution has been stopped, + <item><c>break</c> - Process execution is stopped, normally at a breakpoint. <c>Info={Module,Line}</c>.</item> - <item><c>exit</c> - the process has terminated. + <item><c>exit</c> - The process is terminated. <c>Info=ExitReason</c>.</item> - <item><c>no_conn</c> - the connection is down to the node + <item><c>no_conn</c> - The connection is down to the node where the process is running. <c>Info={}</c>.</item> </list> </desc> @@ -503,7 +521,7 @@ spawn(Module, Name, [Pid | Args]) <func> <name>clear() -> ok</name> <fsummary>Clear information about processes executing interpreted - code</fsummary> + code.</fsummary> <desc> <p>Clears information about processes executing interpreted code by removing all information about terminated processes.</p> @@ -513,13 +531,13 @@ spawn(Module, Name, [Pid | Args]) <func> <name>continue(Pid) -> ok | {error,not_interpreted}</name> <name>continue(X,Y,Z) -> ok | {error,not_interpreted}</name> - <fsummary>Resume process execution</fsummary> + <fsummary>Resume process execution.</fsummary> <type> <v>Pid = pid()</v> <v>X = Y = Z = int()</v> </type> <desc> - <p>Resume process execution for <c>Pid</c>, or for + <p>Resumes process execution for <c>Pid</c> or <c>c:pid(X,Y,Z)</c>.</p> </desc> </func> diff --git a/lib/debugger/doc/src/introduction.xml b/lib/debugger/doc/src/introduction.xml new file mode 100644 index 0000000000..9f5f279bb0 --- /dev/null +++ b/lib/debugger/doc/src/introduction.xml @@ -0,0 +1,63 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> + +<chapter> +<header> + <copyright> + <year>1997</year><year>2013</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>Introduction</title> + <prepared></prepared> + <docno></docno> + <date></date> + <rev></rev> + <file>introduction.xml</file> + </header> + + <section> + <title>Scope</title> + <p>Debugger is a graphical user interface for the Erlang + interpreter, which can be used for debugging and testing of + Erlang programs. For example, breakpoints can be set, code can be + single-stepped and variable values can be displayed and changed. + </p> + + <p>The Erlang interpreter can also be accessed through the interface + module <seealso marker="int"><c>int(3)</c></seealso>. + </p> + + <warning> + <p>Debugger might at some point + start tracing on the processes that execute the interpreted + code. This means that a conflict occurs if tracing by other + means is started on any of these processes.</p> + </warning> + </section> + + <section> + <title>Prerequisites</title> + <p>It is assumed that the reader is familiar with the Erlang + programming language.</p> + <p>Modules to be debugged must include debug information, + for example, <c>erlc +debug_info MODULE.erl</c>.</p> + </section> + +</chapter> + + diff --git a/lib/debugger/doc/src/part.xml b/lib/debugger/doc/src/part.xml index 7515c0ad5b..ce1edbd978 100644 --- a/lib/debugger/doc/src/part.xml +++ b/lib/debugger/doc/src/part.xml @@ -4,7 +4,7 @@ <part xmlns:xi="http://www.w3.org/2001/XInclude"> <header> <copyright> - <year>1997</year><year>2013</year> + <year>1997</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -27,14 +27,10 @@ <docno></docno> <date>1998-05-12</date> <rev>B</rev> - <file>part.sgml</file> + <file>part.xml</file> </header> - <description> - <p><em>Debugger</em> is a graphical tool which can be used for - debugging and testing of Erlang programs. For example, breakpoints - can be set, code can be single stepped and variable values can be - displayed and changed.</p> - </description> + <description></description> + <xi:include href="introduction.xml"/> <xi:include href="debugger_chapter.xml"/> </part> diff --git a/lib/debugger/doc/src/ref_man.xml b/lib/debugger/doc/src/ref_man.xml index 6df9e90c2c..c44f07f912 100644 --- a/lib/debugger/doc/src/ref_man.xml +++ b/lib/debugger/doc/src/ref_man.xml @@ -28,12 +28,7 @@ <date></date> <rev></rev> </header> - <description> - <p><em>Debugger</em> is a graphical tool which can be used for - debugging and testing of Erlang programs. For example, breakpoints - can be set, code can be single stepped and variable values can be - displayed and changed.</p> - </description> + <description></description> <xi:include href="debugger.xml"/> <xi:include href="i.xml"/> <xi:include href="int.xml"/> diff --git a/lib/debugger/src/dbg_icmd.erl b/lib/debugger/src/dbg_icmd.erl index 4c34f253c6..1b274e20ae 100644 --- a/lib/debugger/src/dbg_icmd.erl +++ b/lib/debugger/src/dbg_icmd.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2015. All Rights Reserved. +%% 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. @@ -267,7 +267,7 @@ handle_int_msg({old_code,Mod}, Status, Bs, #ieval{level=Le,module=M}=Ieval) -> if Status =:= idle, Le =:= 1 -> - erase([Mod|db]), + erase(?DB_REF_KEY(Mod)), put(cache, []); true -> case dbg_istk:in_use_p(Mod, M) of @@ -277,7 +277,7 @@ handle_int_msg({old_code,Mod}, Status, Bs, exit(get(self), kill), dbg_ieval:exception(exit, old_code, Bs, Ieval); false -> - erase([Mod|db]), + erase(?DB_REF_KEY(Mod)), put(cache, []) end end; diff --git a/lib/debugger/src/dbg_ieval.erl b/lib/debugger/src/dbg_ieval.erl index 7ed371a653..f5e079ef7e 100644 --- a/lib/debugger/src/dbg_ieval.erl +++ b/lib/debugger/src/dbg_ieval.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2015. All Rights Reserved. +%% 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. @@ -560,7 +560,7 @@ get_function(Mod, Name, Args, extern) -> end. db_ref(Mod) -> - case get([Mod|db]) of + case get(?DB_REF_KEY(Mod)) of undefined -> case dbg_iserver:call(get(int), {get_module_db, Mod, get(self)}) of @@ -572,7 +572,7 @@ db_ref(Mod) -> Node =/= node() -> {Node,ModDb}; true -> ModDb end, - put([Mod|db], DbRef), + put(?DB_REF_KEY(Mod), DbRef), DbRef end; DbRef -> diff --git a/lib/debugger/src/dbg_ieval.hrl b/lib/debugger/src/dbg_ieval.hrl index 95d0842b19..ad422a9e4a 100644 --- a/lib/debugger/src/dbg_ieval.hrl +++ b/lib/debugger/src/dbg_ieval.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2011. All Rights Reserved. +%% Copyright Ericsson AB 2005-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. @@ -27,3 +27,5 @@ %% (i.e. the next call will leave interpreted code). top = false }). + +-define(DB_REF_KEY(Mod), {Mod,db}). diff --git a/lib/debugger/src/dbg_iload.erl b/lib/debugger/src/dbg_iload.erl index 2a8bcd32d8..369b456524 100644 --- a/lib/debugger/src/dbg_iload.erl +++ b/lib/debugger/src/dbg_iload.erl @@ -39,7 +39,7 @@ %% dbg_iserver. We are suspended until the module has been loaded. %%-------------------------------------------------------------------- -spec load_mod(Mod, file:filename(), binary(), ets:tid()) -> - {'ok', Mod} when is_subtype(Mod, atom()). + {'ok', Mod} when Mod :: atom(). load_mod(Mod, File, Binary, Db) -> Flag = process_flag(trap_exit, true), @@ -541,7 +541,7 @@ fun_clauses([]) -> []. new_map(Fs0, Anno, F) -> Line = ln(Anno), Fs1 = map_fields(Fs0, F), - Fs2 = [{ln(A),K,V} || {map_field_assoc,A,K,V} <- Fs1], + Fs2 = [{L,K,V} || {map_field_assoc,L,K,V} <- Fs1], try {value,Line,map_literal(Fs2, #{})} catch diff --git a/lib/debugger/src/dbg_wx_trace.erl b/lib/debugger/src/dbg_wx_trace.erl index 5fd1519ba0..f9c60f9b72 100644 --- a/lib/debugger/src/dbg_wx_trace.erl +++ b/lib/debugger/src/dbg_wx_trace.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2014. All Rights Reserved. +%% Copyright Ericsson AB 2008-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. @@ -811,7 +811,7 @@ gui_show_module(Win, Mod, Line, Mod, _Pid, How) -> dbg_wx_trace_win:mark_line(Win, Line, How); gui_show_module(Win, Mod, Line, _Cm, Pid, How) -> Win2 = case dbg_wx_trace_win:is_shown(Win, Mod) of - {true, Win3} -> Win3; + %% {true, Win3} -> Win3; false -> gui_load_module(Win, Mod, Pid) end, dbg_wx_trace_win:mark_line(Win2, Line, How). diff --git a/lib/debugger/src/dbg_wx_win.erl b/lib/debugger/src/dbg_wx_win.erl index 63f74392b5..1ff8818bbe 100644 --- a/lib/debugger/src/dbg_wx_win.erl +++ b/lib/debugger/src/dbg_wx_win.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2013. All Rights Reserved. +%% Copyright Ericsson AB 2008-2015. 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. @@ -95,10 +95,9 @@ create_menu_item(Menu, [{Name, _N, cascade, Items}|Is], Win, Id0,Connect) -> false -> Acc end end, - Filter = fun(_,_) -> + Filter = fun(Ev,_) -> Enabled = lists:foldl(IsChecked, [], Butts), - Self ! #wx{userData={Name, Enabled}, - event=#wxCommand{type=command_menu_selected}} + Self ! Ev#wx{userData={Name, Enabled}} end, wxMenu:connect(Win, command_menu_selected, [{id,Id0},{lastId, Id-1},{callback,Filter}]), diff --git a/lib/debugger/test/Makefile b/lib/debugger/test/Makefile index 82f49c155f..1594c891b4 100644 --- a/lib/debugger/test/Makefile +++ b/lib/debugger/test/Makefile @@ -68,7 +68,7 @@ RELSYSDIR = $(RELEASE_PATH)/debugger_test # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +ERL_COMPILE_FLAGS += EBIN = . diff --git a/lib/debugger/test/andor_SUITE.erl b/lib/debugger/test/andor_SUITE.erl index 384b6c7c77..9750fa018d 100644 --- a/lib/debugger/test/andor_SUITE.erl +++ b/lib/debugger/test/andor_SUITE.erl @@ -27,7 +27,7 @@ t_andalso/1,t_orelse/1,inside/1,overlap/1, combined/1,in_case/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/debugger/test/bs_bincomp_SUITE.erl b/lib/debugger/test/bs_bincomp_SUITE.erl index 0750c6793d..18b4198354 100644 --- a/lib/debugger/test/bs_bincomp_SUITE.erl +++ b/lib/debugger/test/bs_bincomp_SUITE.erl @@ -30,7 +30,7 @@ byte_aligned/1,bit_aligned/1,extended_byte_aligned/1, extended_bit_aligned/1,mixed/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). init_per_testcase(_Case, Config) -> test_lib:interpret(?MODULE), diff --git a/lib/debugger/test/bs_construct_SUITE.erl b/lib/debugger/test/bs_construct_SUITE.erl index f62512568f..966c096c3a 100644 --- a/lib/debugger/test/bs_construct_SUITE.erl +++ b/lib/debugger/test/bs_construct_SUITE.erl @@ -36,7 +36,7 @@ copy_writable_binary/1, dynamic/1, otp_7422/1, zero_width/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/debugger/test/bs_match_bin_SUITE.erl b/lib/debugger/test/bs_match_bin_SUITE.erl index a61b56501c..98c1013210 100644 --- a/lib/debugger/test/bs_match_bin_SUITE.erl +++ b/lib/debugger/test/bs_match_bin_SUITE.erl @@ -27,7 +27,7 @@ init_per_suite/1,end_per_suite/1, byte_split_binary/1,bit_split_binary/1,match_huge_bin/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/debugger/test/bs_match_int_SUITE.erl b/lib/debugger/test/bs_match_int_SUITE.erl index fd77530dd5..11b5e30efd 100644 --- a/lib/debugger/test/bs_match_int_SUITE.erl +++ b/lib/debugger/test/bs_match_int_SUITE.erl @@ -26,7 +26,7 @@ integer/1,signed_integer/1,dynamic/1,more_dynamic/1,mml/1, match_huge_int/1,bignum/1,unaligned_32_bit/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -import(lists, [seq/2]). diff --git a/lib/debugger/test/bs_match_misc_SUITE.erl b/lib/debugger/test/bs_match_misc_SUITE.erl index 2221cfe08b..7196026dc7 100644 --- a/lib/debugger/test/bs_match_misc_SUITE.erl +++ b/lib/debugger/test/bs_match_misc_SUITE.erl @@ -29,7 +29,7 @@ writable_binary_matched/1,otp_7198/1, unordered_bindings/1,float_middle_endian/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/debugger/test/bs_match_tail_SUITE.erl b/lib/debugger/test/bs_match_tail_SUITE.erl index 9ec93978ed..f4201ee7db 100644 --- a/lib/debugger/test/bs_match_tail_SUITE.erl +++ b/lib/debugger/test/bs_match_tail_SUITE.erl @@ -26,7 +26,7 @@ init_per_suite/1,end_per_suite/1, aligned/1,unaligned/1,zero_tail/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/debugger/test/bs_utf_SUITE.erl b/lib/debugger/test/bs_utf_SUITE.erl index 90c4d6c7b9..5bf776226a 100644 --- a/lib/debugger/test/bs_utf_SUITE.erl +++ b/lib/debugger/test/bs_utf_SUITE.erl @@ -28,7 +28,7 @@ utf8_roundtrip/1,unused_utf_char/1,utf16_roundtrip/1, utf32_roundtrip/1,guard/1,extreme_tripping/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -compile([no_jopt,time]). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/debugger/test/bug_SUITE.erl b/lib/debugger/test/bug_SUITE.erl index 542db3f41e..516d9f4b8d 100644 --- a/lib/debugger/test/bug_SUITE.erl +++ b/lib/debugger/test/bug_SUITE.erl @@ -21,7 +21,7 @@ %% -module(bug_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). diff --git a/lib/debugger/test/cleanup.erl b/lib/debugger/test/cleanup.erl index b40ae5f82c..58f3c9380f 100644 --- a/lib/debugger/test/cleanup.erl +++ b/lib/debugger/test/cleanup.erl @@ -23,7 +23,7 @@ -export([all/0,groups/0,init_per_group/2,end_per_group/2, cleanup/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). all() -> [cleanup]. diff --git a/lib/debugger/test/dbg_ui_SUITE.erl b/lib/debugger/test/dbg_ui_SUITE.erl index f0f4e09aa8..39ecb51b57 100644 --- a/lib/debugger/test/dbg_ui_SUITE.erl +++ b/lib/debugger/test/dbg_ui_SUITE.erl @@ -22,7 +22,7 @@ -module(dbg_ui_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). % Test server specific exports diff --git a/lib/debugger/test/debugger_SUITE.erl b/lib/debugger/test/debugger_SUITE.erl index 9207df38e4..678ca0e5c3 100644 --- a/lib/debugger/test/debugger_SUITE.erl +++ b/lib/debugger/test/debugger_SUITE.erl @@ -23,7 +23,7 @@ %% Test break points. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, diff --git a/lib/debugger/test/erl_eval_SUITE.erl b/lib/debugger/test/erl_eval_SUITE.erl index af9b0a6e6e..c75e4012f3 100644 --- a/lib/debugger/test/erl_eval_SUITE.erl +++ b/lib/debugger/test/erl_eval_SUITE.erl @@ -60,7 +60,7 @@ config(priv_dir,_) -> ".". -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([init_per_testcase/2, end_per_testcase/2]). % Default timetrap timeout (set in init_per_testcase). -define(default_timeout, ?t:minutes(1)). diff --git a/lib/debugger/test/exception_SUITE.erl b/lib/debugger/test/exception_SUITE.erl index f42dbc7776..e35326a798 100644 --- a/lib/debugger/test/exception_SUITE.erl +++ b/lib/debugger/test/exception_SUITE.erl @@ -28,7 +28,7 @@ -export([bad_guy/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/debugger/test/fun_SUITE.erl b/lib/debugger/test/fun_SUITE.erl index fabee16cee..b8092ab16c 100644 --- a/lib/debugger/test/fun_SUITE.erl +++ b/lib/debugger/test/fun_SUITE.erl @@ -30,7 +30,7 @@ %% Internal exports. -export([nothing/0,call_me/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/debugger/test/guard_SUITE.erl b/lib/debugger/test/guard_SUITE.erl index 880c89532b..2b87ef23ba 100644 --- a/lib/debugger/test/guard_SUITE.erl +++ b/lib/debugger/test/guard_SUITE.erl @@ -39,7 +39,7 @@ check_qlc_hrl/1,andalso_semi/1,t_tuple_size/1,binary_part/1, bad_constants/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([init/4]). -import(lists, [member/2]). diff --git a/lib/debugger/test/int_SUITE.erl b/lib/debugger/test/int_SUITE.erl index 5f2e4dd84d..8b16b7631b 100644 --- a/lib/debugger/test/int_SUITE.erl +++ b/lib/debugger/test/int_SUITE.erl @@ -20,7 +20,7 @@ %% -module(int_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Test server specific exports -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/lib/debugger/test/int_break_SUITE.erl b/lib/debugger/test/int_break_SUITE.erl index 21b53a8d30..75bdd69a7d 100644 --- a/lib/debugger/test/int_break_SUITE.erl +++ b/lib/debugger/test/int_break_SUITE.erl @@ -22,7 +22,7 @@ %% Test break points. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, diff --git a/lib/debugger/test/int_eval_SUITE.erl b/lib/debugger/test/int_eval_SUITE.erl index f30d386de9..3f3c03492e 100644 --- a/lib/debugger/test/int_eval_SUITE.erl +++ b/lib/debugger/test/int_eval_SUITE.erl @@ -36,7 +36,7 @@ -define(IM, my_int_eval_module). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap,{minutes,1}}]. diff --git a/lib/debugger/test/lc_SUITE.erl b/lib/debugger/test/lc_SUITE.erl index aca4c4de7c..851d0fbc20 100644 --- a/lib/debugger/test/lc_SUITE.erl +++ b/lib/debugger/test/lc_SUITE.erl @@ -28,7 +28,7 @@ basic/1,deeply_nested/1,no_generator/1, empty_generator/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/debugger/test/line_number_SUITE.erl b/lib/debugger/test/line_number_SUITE.erl index 6ec5ef5d5a..592f0a1f32 100644 --- a/lib/debugger/test/line_number_SUITE.erl +++ b/lib/debugger/test/line_number_SUITE.erl @@ -26,7 +26,7 @@ line_numbers/1]). -export([crash/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/debugger/test/map_SUITE.erl b/lib/debugger/test/map_SUITE.erl index 0ef634f7aa..eabcdcbf42 100644 --- a/lib/debugger/test/map_SUITE.erl +++ b/lib/debugger/test/map_SUITE.erl @@ -2219,7 +2219,7 @@ map_guard_sequence_mixed(K1,K2,M) -> t_frequency_table(Config) when is_list(Config) -> - random:seed({13,1337,54}), % pseudo random + rand:seed(exsplus, {13,1337,54}), % pseudo random N = 1000, Ts = rand_terms(N), #{ n:=N, tf := Tf } = frequency_table(Ts,#{ n=>0, tf => #{}}), @@ -2262,7 +2262,7 @@ rand_terms(0) -> []; rand_terms(N) -> [rand_term()|rand_terms(N-1)]. rand_term() -> - case random:uniform(6) of + case rand:uniform(6) of 1 -> rand_binary(); 2 -> rand_number(); 3 -> rand_atom(); @@ -2272,21 +2272,21 @@ rand_term() -> end. rand_binary() -> - case random:uniform(3) of + case rand:uniform(3) of 1 -> <<>>; 2 -> <<"hi">>; 3 -> <<"message text larger than 64 bytes. yep, message text larger than 64 bytes.">> end. rand_number() -> - case random:uniform(3) of - 1 -> random:uniform(5); - 2 -> float(random:uniform(5)); - 3 -> 1 bsl (63 + random:uniform(3)) + case rand:uniform(3) of + 1 -> rand:uniform(5); + 2 -> float(rand:uniform(5)); + 3 -> 1 bsl (63 + rand:uniform(3)) end. rand_atom() -> - case random:uniform(3) of + case rand:uniform(3) of 1 -> hi; 2 -> some_atom; 3 -> some_other_atom @@ -2294,21 +2294,21 @@ rand_atom() -> rand_tuple() -> - case random:uniform(3) of + case rand:uniform(3) of 1 -> {ok, rand_term()}; % careful 2 -> {1, 2, 3}; 3 -> {<<"yep">>, 1337} end. rand_list() -> - case random:uniform(3) of + case rand:uniform(3) of 1 -> "hi"; 2 -> [1,rand_term()]; % careful 3 -> [improper|list] end. rand_map() -> - case random:uniform(3) of + case rand:uniform(3) of 1 -> #{ hi => 3 }; 2 -> #{ wat => rand_term(), other => 3 }; % careful 3 -> #{ hi => 42, other => 42, yet_anoter => 1337 } diff --git a/lib/debugger/test/record_SUITE.erl b/lib/debugger/test/record_SUITE.erl index 2f663e2dfc..115e65c685 100644 --- a/lib/debugger/test/record_SUITE.erl +++ b/lib/debugger/test/record_SUITE.erl @@ -23,7 +23,7 @@ -module(record_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, diff --git a/lib/debugger/test/trycatch_SUITE.erl b/lib/debugger/test/trycatch_SUITE.erl index 7fdd98fc71..0303d1bd82 100644 --- a/lib/debugger/test/trycatch_SUITE.erl +++ b/lib/debugger/test/trycatch_SUITE.erl @@ -28,7 +28,7 @@ catch_oops/1,after_oops/1,eclectic/1,rethrow/1, nested_of/1,nested_catch/1,nested_after/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/dialyzer/doc/src/dialyzer.xml b/lib/dialyzer/doc/src/dialyzer.xml index 3fd34241b2..619db125b1 100644 --- a/lib/dialyzer/doc/src/dialyzer.xml +++ b/lib/dialyzer/doc/src/dialyzer.xml @@ -254,7 +254,7 @@ analysis that finds data races performs intra-procedural data flow analysis and can sometimes explode in time. Enable it at your own risk. </item> -i <tag><c><![CDATA[-Wunderspecs]]></c>***</tag> + <tag><c><![CDATA[-Wunderspecs]]></c>***</tag> <item>Warn about underspecified functions (the -spec is strictly more allowing than the success typing).</item> <tag><c><![CDATA[-Wunknown]]></c>***</tag> diff --git a/lib/dialyzer/src/Makefile b/lib/dialyzer/src/Makefile index 770af2140f..fd75cd5cd8 100644 --- a/lib/dialyzer/src/Makefile +++ b/lib/dialyzer/src/Makefile @@ -61,6 +61,7 @@ MODULES = \ dialyzer_gui_wx \ dialyzer_options \ dialyzer_plt \ + dialyzer_race_data_server \ dialyzer_races \ dialyzer_succ_typings \ dialyzer_timing \ @@ -140,6 +141,7 @@ $(EBIN)/dialyzer_explanation.beam: dialyzer.hrl $(EBIN)/dialyzer_gui_wx.beam: dialyzer.hrl dialyzer_gui_wx.hrl $(EBIN)/dialyzer_options.beam: dialyzer.hrl $(EBIN)/dialyzer_plt.beam: dialyzer.hrl +$(EBIN)/dialyzer_race_data_server.beam: dialyzer.hrl $(EBIN)/dialyzer_races.beam: dialyzer.hrl $(EBIN)/dialyzer_succ_typings.beam: dialyzer.hrl $(EBIN)/dialyzer_typesig.beam: dialyzer.hrl diff --git a/lib/dialyzer/src/dialyzer.app.src b/lib/dialyzer/src/dialyzer.app.src index 8ac6dc1367..003d7f2ba4 100644 --- a/lib/dialyzer/src/dialyzer.app.src +++ b/lib/dialyzer/src/dialyzer.app.src @@ -37,6 +37,7 @@ dialyzer_gui_wx, dialyzer_options, dialyzer_plt, + dialyzer_race_data_server, dialyzer_races, dialyzer_succ_typings, dialyzer_typesig, @@ -44,7 +45,7 @@ dialyzer_timing, dialyzer_worker]}, {registered, []}, - {applications, [compiler, gs, hipe, kernel, stdlib, wx]}, + {applications, [compiler, hipe, kernel, stdlib, wx]}, {env, []}, {runtime_dependencies, ["wx-1.2","syntax_tools-1.6.14","stdlib-2.5", "kernel-3.0","hipe-3.13","erts-7.0", diff --git a/lib/dialyzer/src/dialyzer.hrl b/lib/dialyzer/src/dialyzer.hrl index de236f91ab..601e2e954b 100644 --- a/lib/dialyzer/src/dialyzer.hrl +++ b/lib/dialyzer/src/dialyzer.hrl @@ -2,7 +2,7 @@ %%% %%% %CopyrightBegin% %%% -%%% Copyright Ericsson AB 2006-2014. All Rights Reserved. +%%% Copyright Ericsson AB 2006-2015. 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. @@ -123,10 +123,12 @@ %% Record declarations used by various files %%-------------------------------------------------------------------- --record(analysis, {analysis_pid :: pid(), +-type doc_plt() :: 'undefined' | dialyzer_plt:plt(). + +-record(analysis, {analysis_pid :: pid() | 'undefined', type = succ_typings :: anal_type(), defines = [] :: [dial_define()], - doc_plt :: dialyzer_plt:plt(), + doc_plt :: doc_plt(), files = [] :: [file:filename()], include_dirs = [] :: [file:filename()], start_from = byte_code :: start_from(), @@ -135,7 +137,7 @@ race_detection = false :: boolean(), behaviours_chk = false :: boolean(), timing = false :: boolean() | 'debug', - timing_server :: dialyzer_timing:timing_server(), + timing_server = none :: dialyzer_timing:timing_server(), callgraph_file = "" :: file:filename(), solvers :: [solver()]}). diff --git a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl index c57a22129c..50fc1d8471 100644 --- a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl +++ b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl @@ -2,7 +2,7 @@ %%-------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2015. All Rights Reserved. +%% Copyright Ericsson AB 2006-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. @@ -31,14 +31,17 @@ -export([start/3]). +%%% Export for dialyzer_coordinator... -export([compile_init_result/0, - add_to_result/4, - start_compilation/2, + add_to_result/4]). +%%% ... and export for dialyzer_worker. +-export([start_compilation/2, continue_compilation/2]). -export_type([compile_init_data/0, - one_file_result/0, - compile_result/0]). + one_file_mid_error/0, + one_file_result_ok/0, + compile_result/0]). -include("dialyzer.hrl"). @@ -93,31 +96,19 @@ loop(#server_state{parent = Parent} = State, send_log(Parent, LogMsg), loop(State, Analysis, ExtCalls); {AnalPid, warnings, Warnings} -> - case Warnings of - [] -> ok; - SendWarnings -> - send_warnings(Parent, SendWarnings) - end, + send_warnings(Parent, Warnings), loop(State, Analysis, ExtCalls); {AnalPid, cserver, CServer, Plt} -> send_codeserver_plt(Parent, CServer, Plt), loop(State, Analysis, ExtCalls); {AnalPid, done, Plt, DocPlt} -> - case ExtCalls =:= none of - true -> - send_analysis_done(Parent, Plt, DocPlt); - false -> - send_ext_calls(Parent, ExtCalls), - send_analysis_done(Parent, Plt, DocPlt) - end; + send_ext_calls(Parent, ExtCalls), + send_analysis_done(Parent, Plt, DocPlt); {AnalPid, ext_calls, NewExtCalls} -> loop(State, Analysis, NewExtCalls); {AnalPid, ext_types, ExtTypes} -> send_ext_types(Parent, ExtTypes), loop(State, Analysis, ExtCalls); - {AnalPid, unknown_behaviours, UnknownBehaviour} -> - send_unknown_behaviours(Parent, UnknownBehaviour), - loop(State, Analysis, ExtCalls); {AnalPid, mod_deps, ModDeps} -> send_mod_deps(Parent, ModDeps), loop(State, Analysis, ExtCalls); @@ -165,8 +156,7 @@ analysis_start(Parent, Analysis, LegalWarnings) -> MergedExpTypes = sets:union(NewExpTypes, OldExpTypes1), TmpCServer1 = dialyzer_codeserver:set_temp_records(MergedRecords, TmpCServer0), TmpCServer2 = - dialyzer_codeserver:insert_temp_exported_types(MergedExpTypes, - TmpCServer1), + dialyzer_codeserver:finalize_exported_types(MergedExpTypes, TmpCServer1), ?timing(State#analysis_state.timing_server, "remote", begin TmpCServer3 = @@ -259,6 +249,10 @@ compile_and_store(Files, #analysis_state{codeserver = CServer, {T1, _} = statistics(wall_clock), Callgraph = dialyzer_callgraph:new(), CompileInit = make_compile_init(State, Callgraph), + %% Spawn a worker per file - where each worker calls + %% start_compilation on its file, asks next label to coordinator and + %% calls continue_compilation - and let coordinator aggregate + %% results using (compile_init_result and) add_to_result. {{Failed, Modules}, NextLabel} = ?timing(Timing, "compile", _C1, dialyzer_coordinator:parallel_job(compile, Files, @@ -290,16 +284,18 @@ compile_and_store(Files, #analysis_state{codeserver = CServer, send_log(Parent, Msg2), {Callgraph, CServer2}. --type compile_init_data() :: #compile_init{}. --type error_reason() :: string(). --type compile_result() :: {[{file:filename(), error_reason()}], - [module()]}. %%opaque --type one_file_result() :: {error, error_reason()} | - {ok, [dialyzer_callgraph:callgraph_edge()], - [mfa_or_funlbl()], module()}. %%opaque --type compile_mid_data() :: {module(), cerl:cerl(), - dialyzer_callgraph:callgraph(), - dialyzer_codeserver:codeserver()}. +-opaque compile_init_data() :: #compile_init{}. +-type error_reason() :: string(). +-opaque compile_result() :: {[{file:filename(), error_reason()}], + [module()]}. +-type one_file_mid_error() :: {error, error_reason()}. +-opaque one_file_result_ok() :: {ok, [dialyzer_callgraph:callgraph_edge()], + [mfa_or_funlbl()], module()}. +-type one_file_result() :: one_file_mid_error() | + one_file_result_ok(). +-type compile_mid_data() :: {module(), cerl:cerl(), + dialyzer_callgraph:callgraph(), + dialyzer_codeserver:codeserver()}. -spec compile_init_result() -> compile_result(). @@ -440,7 +436,8 @@ store_core(Mod, Core, Callgraph, CServer) -> CoreSize = cerl_trees:size(CoreTree), {ok, CoreSize, {Mod, CoreTree, Callgraph, CServer}}. --spec continue_compilation(integer(), compile_mid_data()) -> one_file_result(). +-spec continue_compilation(integer(), compile_mid_data()) -> + one_file_result_ok(). continue_compilation(NextLabel, {Mod, CoreTree, Callgraph, CServer}) -> {LabeledTree, _NewNextLabel} = cerl_trees:label(CoreTree, NextLabel), @@ -572,6 +569,8 @@ send_analysis_done(Parent, Plt, DocPlt) -> Parent ! {self(), done, Plt, DocPlt}, ok. +send_ext_calls(_Parent, none) -> + ok; send_ext_calls(Parent, ExtCalls) -> Parent ! {self(), ext_calls, ExtCalls}, ok. @@ -580,10 +579,6 @@ send_ext_types(Parent, ExtTypes) -> Parent ! {self(), ext_types, ExtTypes}, ok. -send_unknown_behaviours(Parent, UnknownBehaviours) -> - Parent ! {self(), unknown_behaviours, UnknownBehaviours}, - ok. - send_codeserver_plt(Parent, CServer, Plt ) -> Parent ! {self(), cserver, CServer, Plt}, ok. @@ -624,6 +619,28 @@ find_call_file_and_line(Tree, MFA) -> MFA -> Ann = cerl:get_ann(SubTree), [{get_file(Ann), get_line(Ann)}|Acc]; + {erlang, make_fun, 3} -> + [CA1, CA2, CA3] = cerl:call_args(SubTree), + case + cerl:is_c_atom(CA1) andalso + cerl:is_c_atom(CA2) andalso + cerl:is_c_int(CA3) + of + true -> + case + {cerl:concrete(CA1), + cerl:concrete(CA2), + cerl:concrete(CA3)} + of + MFA -> + Ann = cerl:get_ann(SubTree), + [{get_file(Ann), get_line(Ann)}|Acc]; + _ -> + Acc + end; + false -> + Acc + end; _ -> Acc end; false -> Acc diff --git a/lib/dialyzer/src/dialyzer_callgraph.erl b/lib/dialyzer/src/dialyzer_callgraph.erl index a1cd2015ca..50abb22009 100644 --- a/lib/dialyzer/src/dialyzer_callgraph.erl +++ b/lib/dialyzer/src/dialyzer_callgraph.erl @@ -2,7 +2,7 @@ %%----------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2014. All Rights Reserved. +%% Copyright Ericsson AB 2006-2015. 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. @@ -96,26 +96,28 @@ %% whenever applicable. %%----------------------------------------------------------------------------- +%% Types with comment 'race' are due to dialyzer_races.erl. -record(callgraph, {digraph = digraph:new() :: digraph:graph(), - active_digraph :: active_digraph(), - esc :: ets:tid(), - letrec_map :: ets:tid(), + active_digraph :: active_digraph() + | 'undefined', % race + esc :: ets:tid() + | 'undefined', % race + letrec_map :: ets:tid() + | 'undefined', % race name_map :: ets:tid(), rev_name_map :: ets:tid(), - rec_var_map :: ets:tid(), - self_rec :: ets:tid(), - calls :: ets:tid(), + rec_var_map :: ets:tid() + | 'undefined', % race + self_rec :: ets:tid() + | 'undefined', % race + calls :: ets:tid() + | 'undefined', % race race_detection = false :: boolean(), - race_data_server = new_race_data_server() :: pid()}). - --record(race_data_state, {race_code = dict:new() :: dict:dict(), - public_tables = [] :: [label()], - named_tables = [] :: [string()], - beh_api_calls = [] :: [{mfa(), mfa()}]}). + race_data_server = dialyzer_race_data_server:new() :: pid()}). %% Exported Types --type callgraph() :: #callgraph{}. +-opaque callgraph() :: #callgraph{}. -type active_digraph() :: {'d', digraph:graph()} | {'e', ets:tid(), ets:tid()}. @@ -478,14 +480,37 @@ scan_one_core_fun(TopTree, FunName) -> call -> CalleeM = cerl:call_module(Tree), CalleeF = cerl:call_name(Tree), - A = length(cerl:call_args(Tree)), + CalleeArgs = cerl:call_args(Tree), + A = length(CalleeArgs), case (cerl:is_c_atom(CalleeM) andalso cerl:is_c_atom(CalleeF)) of true -> M = cerl:atom_val(CalleeM), F = cerl:atom_val(CalleeF), case erl_bif_types:is_known(M, F, A) of - true -> Acc; + true -> + case {M, F, A} of + {erlang, make_fun, 3} -> + [CA1, CA2, CA3] = CalleeArgs, + case + cerl:is_c_atom(CA1) andalso + cerl:is_c_atom(CA2) andalso + cerl:is_c_int(CA3) + of + true -> + MM = cerl:atom_val(CA1), + FF = cerl:atom_val(CA2), + AA = cerl:int_val(CA3), + case erl_bif_types:is_known(MM, FF, AA) of + true -> Acc; + false -> [{FunName, {MM, FF, AA}}|Acc] + end; + false -> + Acc + end; + _ -> + Acc + end; false -> [{FunName, {M, F, A}}|Acc] end; false -> @@ -586,45 +611,30 @@ digraph_reaching_subgraph(Funs, DG) -> renew_race_info(#callgraph{race_data_server = RaceDataServer} = CG, RaceCode, PublicTables, NamedTables) -> - ok = race_data_server_cast( + ok = dialyzer_race_data_server:cast( {renew_race_info, {RaceCode, PublicTables, NamedTables}}, RaceDataServer), CG. -renew_race_info({RaceCode, PublicTables, NamedTables}, - #race_data_state{} = State) -> - State#race_data_state{race_code = RaceCode, - public_tables = PublicTables, - named_tables = NamedTables}. - -spec renew_race_code(dialyzer_races:races(), callgraph()) -> callgraph(). renew_race_code(Races, #callgraph{race_data_server = RaceDataServer} = CG) -> Fun = dialyzer_races:get_curr_fun(Races), FunArgs = dialyzer_races:get_curr_fun_args(Races), Code = lists:reverse(dialyzer_races:get_race_list(Races)), - ok = race_data_server_cast( + ok = dialyzer_race_data_server:cast( {renew_race_code, {Fun, FunArgs, Code}}, RaceDataServer), CG. -renew_race_code_handler({Fun, FunArgs, Code}, - #race_data_state{race_code = RaceCode} = State) -> - State#race_data_state{race_code = dict:store(Fun, [FunArgs, Code], RaceCode)}. - -spec renew_race_public_tables(label(), callgraph()) -> callgraph(). renew_race_public_tables(VarLabel, #callgraph{race_data_server = RaceDataServer} = CG) -> ok = - race_data_server_cast({renew_race_public_tables, VarLabel}, RaceDataServer), + dialyzer_race_data_server:cast({renew_race_public_tables, VarLabel}, RaceDataServer), CG. -renew_race_public_tables_handler(VarLabel, - #race_data_state{public_tables = PT} - = State) -> - State#race_data_state{public_tables = ordsets:add_element(VarLabel, PT)}. - -spec cleanup(callgraph()) -> callgraph(). cleanup(#callgraph{digraph = Digraph, @@ -634,18 +644,18 @@ cleanup(#callgraph{digraph = Digraph, #callgraph{digraph = Digraph, name_map = NameMap, rev_name_map = RevNameMap, - race_data_server = race_data_server_call(dup, RaceDataServer)}. + race_data_server = dialyzer_race_data_server:duplicate(RaceDataServer)}. -spec duplicate(callgraph()) -> callgraph(). duplicate(#callgraph{race_data_server = RaceDataServer} = Callgraph) -> Callgraph#callgraph{ - race_data_server = race_data_server_call(dup, RaceDataServer)}. + race_data_server = dialyzer_race_data_server:duplicate(RaceDataServer)}. -spec dispose_race_server(callgraph()) -> ok. dispose_race_server(#callgraph{race_data_server = RaceDataServer}) -> - race_data_server_cast(stop, RaceDataServer). + dialyzer_race_data_server:stop(RaceDataServer). -spec get_digraph(callgraph()) -> digraph:graph(). @@ -655,17 +665,17 @@ get_digraph(#callgraph{digraph = Digraph}) -> -spec get_named_tables(callgraph()) -> [string()]. get_named_tables(#callgraph{race_data_server = RaceDataServer}) -> - race_data_server_call(get_named_tables, RaceDataServer). + dialyzer_race_data_server:call(get_named_tables, RaceDataServer). -spec get_public_tables(callgraph()) -> [label()]. get_public_tables(#callgraph{race_data_server = RaceDataServer}) -> - race_data_server_call(get_public_tables, RaceDataServer). + dialyzer_race_data_server:call(get_public_tables, RaceDataServer). -spec get_race_code(callgraph()) -> dict:dict(). get_race_code(#callgraph{race_data_server = RaceDataServer}) -> - race_data_server_call(get_race_code, RaceDataServer). + dialyzer_race_data_server:call(get_race_code, RaceDataServer). -spec get_race_detection(callgraph()) -> boolean(). @@ -675,12 +685,12 @@ get_race_detection(#callgraph{race_detection = RD}) -> -spec get_behaviour_api_calls(callgraph()) -> [{mfa(), mfa()}]. get_behaviour_api_calls(#callgraph{race_data_server = RaceDataServer}) -> - race_data_server_call(get_behaviour_api_calls, RaceDataServer). + dialyzer_race_data_server:call(get_behaviour_api_calls, RaceDataServer). -spec race_code_new(callgraph()) -> callgraph(). race_code_new(#callgraph{race_data_server = RaceDataServer} = CG) -> - ok = race_data_server_cast(race_code_new, RaceDataServer), + ok = dialyzer_race_data_server:cast(race_code_new, RaceDataServer), CG. -spec put_digraph(digraph:graph(), callgraph()) -> callgraph(). @@ -691,7 +701,7 @@ put_digraph(Digraph, Callgraph) -> -spec put_race_code(dict:dict(), callgraph()) -> callgraph(). put_race_code(RaceCode, #callgraph{race_data_server = RaceDataServer} = CG) -> - ok = race_data_server_cast({put_race_code, RaceCode}, RaceDataServer), + ok = dialyzer_race_data_server:cast({put_race_code, RaceCode}, RaceDataServer), CG. -spec put_race_detection(boolean(), callgraph()) -> callgraph(). @@ -703,78 +713,23 @@ put_race_detection(RaceDetection, Callgraph) -> put_named_tables(NamedTables, #callgraph{race_data_server = RaceDataServer} = CG) -> - ok = race_data_server_cast({put_named_tables, NamedTables}, RaceDataServer), + ok = dialyzer_race_data_server:cast({put_named_tables, NamedTables}, RaceDataServer), CG. -spec put_public_tables([label()], callgraph()) -> callgraph(). put_public_tables(PublicTables, #callgraph{race_data_server = RaceDataServer} = CG) -> - ok = race_data_server_cast({put_public_tables, PublicTables}, RaceDataServer), + ok = dialyzer_race_data_server:cast({put_public_tables, PublicTables}, RaceDataServer), CG. -spec put_behaviour_api_calls([{mfa(), mfa()}], callgraph()) -> callgraph(). put_behaviour_api_calls(Calls, #callgraph{race_data_server = RaceDataServer} = CG) -> - ok = race_data_server_cast({put_behaviour_api_calls, Calls}, RaceDataServer), + ok = dialyzer_race_data_server:cast({put_behaviour_api_calls, Calls}, RaceDataServer), CG. - -new_race_data_server() -> - spawn_link(fun() -> race_data_server_loop(#race_data_state{}) end). - -race_data_server_loop(State) -> - receive - {call, From, Ref, Query} -> - Reply = race_data_server_handle_call(Query, State), - From ! {Ref, Reply}, - race_data_server_loop(State); - {cast, stop} -> - ok; - {cast, Message} -> - NewState = race_data_server_handle_cast(Message, State), - race_data_server_loop(NewState) - end. - -race_data_server_call(Query, Server) -> - Ref = make_ref(), - Server ! {call, self(), Ref, Query}, - receive - {Ref, Reply} -> Reply - end. - -race_data_server_cast(Message, Server) -> - Server ! {cast, Message}, - ok. - -race_data_server_handle_cast(race_code_new, State) -> - State#race_data_state{race_code = dict:new()}; -race_data_server_handle_cast({Tag, Data}, State) -> - case Tag of - renew_race_info -> renew_race_info(Data, State); - renew_race_code -> renew_race_code_handler(Data, State); - renew_race_public_tables -> renew_race_public_tables_handler(Data, State); - put_race_code -> State#race_data_state{race_code = Data}; - put_public_tables -> State#race_data_state{public_tables = Data}; - put_named_tables -> State#race_data_state{named_tables = Data}; - put_behaviour_api_calls -> State#race_data_state{beh_api_calls = Data} - end. - -race_data_server_handle_call(Query, - #race_data_state{race_code = RaceCode, - public_tables = PublicTables, - named_tables = NamedTables, - beh_api_calls = BehApiCalls} - = State) -> - case Query of - dup -> spawn_link(fun() -> race_data_server_loop(State) end); - get_race_code -> RaceCode; - get_public_tables -> PublicTables; - get_named_tables -> NamedTables; - get_behaviour_api_calls -> BehApiCalls - end. - %%============================================================================= %% Utilities for 'dot' %%============================================================================= diff --git a/lib/dialyzer/src/dialyzer_cl.erl b/lib/dialyzer/src/dialyzer_cl.erl index 4116866916..50ff5304d6 100644 --- a/lib/dialyzer/src/dialyzer_cl.erl +++ b/lib/dialyzer/src/dialyzer_cl.erl @@ -36,7 +36,7 @@ -include_lib("kernel/include/file.hrl"). % needed for #file_info{} -record(cl_state, - {backend_pid :: pid(), + {backend_pid :: pid() | 'undefined', erlang_mode = false :: boolean(), external_calls = [] :: [mfa()], external_types = [] :: [mfa()], @@ -49,8 +49,7 @@ plt_info = none :: 'none' | dialyzer_plt:plt_info(), report_mode = normal :: rep_mode(), return_status= ?RET_NOTHING_SUSPICIOUS :: dial_ret(), - stored_warnings = [] :: [raw_warning()], - unknown_behaviours = [] :: [dialyzer_behaviours:behaviour()] + stored_warnings = [] :: [raw_warning()] }). %%-------------------------------------------------------------------- @@ -638,9 +637,6 @@ cl_loop(State, LogCache) -> {BackendPid, warnings, Warnings} -> NewState = store_warnings(State, Warnings), cl_loop(NewState, LogCache); - {BackendPid, unknown_behaviours, Behaviours} -> - NewState = store_unknown_behaviours(State, Behaviours), - cl_loop(NewState, LogCache); {BackendPid, done, NewPlt, _NewDocPlt} -> return_value(State, NewPlt); {BackendPid, ext_calls, ExtCalls} -> @@ -683,11 +679,6 @@ format_log_cache(LogCache) -> store_warnings(#cl_state{stored_warnings = StoredWarnings} = St, Warnings) -> St#cl_state{stored_warnings = StoredWarnings ++ Warnings}. --spec store_unknown_behaviours(#cl_state{}, [dialyzer_behaviours:behaviour()]) -> #cl_state{}. - -store_unknown_behaviours(#cl_state{unknown_behaviours = Behs} = St, Beh) -> - St#cl_state{unknown_behaviours = Beh ++ Behs}. - -spec cl_error(string()) -> no_return(). cl_error(Msg) -> @@ -724,7 +715,6 @@ return_value(State = #cl_state{erlang_mode = ErlangMode, print_warnings(State), print_ext_calls(State), print_ext_types(State), - print_unknown_behaviours(State), maybe_close_output_file(State), {RetValue, []}; true -> @@ -737,8 +727,7 @@ unknown_warnings(State = #cl_state{legal_warnings = LegalWarnings}) -> Unknown = case ordsets:is_element(?WARN_UNKNOWN, LegalWarnings) of true -> unknown_functions(State) ++ - unknown_types(State) ++ - unknown_behaviours(State); + unknown_types(State); false -> [] end, WarningInfo = {_Filename = "", _Line = 0, _MorMFA = ''}, @@ -814,48 +803,6 @@ do_print_ext_types(Output, [{M,F,A}|T], Before) -> do_print_ext_types(_, [], _) -> ok. -unknown_behaviours(#cl_state{unknown_behaviours = DupBehaviours, - legal_warnings = LegalWarnings}) -> - case ordsets:is_element(?WARN_BEHAVIOUR, LegalWarnings) of - false -> []; - true -> - Behaviours = lists:usort(DupBehaviours), - [{unknown_behaviour, B} || B <- Behaviours] - end. - -%%print_unknown_behaviours(#cl_state{report_mode = quiet}) -> -%% ok; -print_unknown_behaviours(#cl_state{output = Output, - external_calls = Calls, - external_types = Types, - stored_warnings = Warnings, - unknown_behaviours = DupBehaviours, - legal_warnings = LegalWarnings, - output_format = Format}) -> - case ordsets:is_element(?WARN_BEHAVIOUR, LegalWarnings) - andalso DupBehaviours =/= [] of - false -> ok; - true -> - Behaviours = lists:usort(DupBehaviours), - case Warnings =:= [] andalso Calls =:= [] andalso Types =:= [] of - true -> io:nl(Output); %% Need to do a newline first - false -> ok - end, - {Prompt, Prefix} = - case Format of - formatted -> {"Unknown behaviours:\n"," "}; - raw -> {"%% Unknown behaviours:\n","%% "} - end, - io:put_chars(Output, Prompt), - do_print_unknown_behaviours(Output, Behaviours, Prefix) - end. - -do_print_unknown_behaviours(Output, [B|T], Before) -> - io:format(Output, "~s~p\n", [Before,B]), - do_print_unknown_behaviours(Output, T, Before); -do_print_unknown_behaviours(_, [], _) -> - ok. - print_warnings(#cl_state{stored_warnings = []}) -> ok; print_warnings(#cl_state{output = Output, diff --git a/lib/dialyzer/src/dialyzer_codeserver.erl b/lib/dialyzer/src/dialyzer_codeserver.erl index 978ecd3843..03cd9671af 100644 --- a/lib/dialyzer/src/dialyzer_codeserver.erl +++ b/lib/dialyzer/src/dialyzer_codeserver.erl @@ -2,7 +2,7 @@ %%----------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2014. All Rights Reserved. +%% Copyright Ericsson AB 2006-2015. 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. @@ -81,10 +81,10 @@ -record(codeserver, {next_core_label = 0 :: label(), code :: dict_ets(), - exported_types :: set_ets(), % set(mfa()) - records :: dict_ets(), - contracts :: dict_ets(), - callbacks :: dict_ets(), + exported_types :: set_ets() | 'undefined', % set(mfa()) + records :: dict_ets() | 'undefined', + contracts :: dict_ets() | 'undefined', + callbacks :: dict_ets() | 'undefined', fun_meta_info :: dict_ets(), % {mfa(), meta_info()} exports :: 'clean' | set_ets(), % set(mfa()) temp_exported_types :: 'clean' | set_ets(), % set(mfa()) diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl index 7251de8b10..e03e4d5bb4 100644 --- a/lib/dialyzer/src/dialyzer_contracts.erl +++ b/lib/dialyzer/src/dialyzer_contracts.erl @@ -2,7 +2,7 @@ %%----------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2015. All Rights Reserved. +%% Copyright Ericsson AB 2007-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. @@ -126,13 +126,19 @@ butlast([H|T]) -> [H|butlast(T)]. constraints_to_string([]) -> ""; -constraints_to_string([{type, _, constraint, [{atom, _, What}, Types]}]) -> - atom_to_list(What) ++ "(" ++ - sequence([erl_types:t_form_to_string(T) || T <- Types], ",") ++ ")"; constraints_to_string([{type, _, constraint, [{atom, _, What}, Types]}|Rest]) -> - atom_to_list(What) ++ "(" ++ - sequence([erl_types:t_form_to_string(T) || T <- Types], ",") - ++ "), " ++ constraints_to_string(Rest). + S = constraint_to_string(What, Types), + case Rest of + [] -> S; + _ -> S ++ ", " ++ constraints_to_string(Rest) + end. + +constraint_to_string(is_subtype, [{var, _, Var}, T]) -> + atom_to_list(Var) ++ " :: " ++ erl_types:t_form_to_string(T); +constraint_to_string(What, Types) -> + atom_to_list(What) ++ "(" + ++ sequence([erl_types:t_form_to_string(T) || T <- Types], ",") + ++ ")". sequence([], _Delimiter) -> ""; sequence([H], _Delimiter) -> H; @@ -161,8 +167,7 @@ process_contract_remote_types(CodeServer) -> dialyzer_codeserver:finalize_contracts(NewContractDict, NewCallbackDict, CodeServer). --type opaques() :: [erl_types:erl_type()] | 'universe'. --type opaques_fun() :: fun((module()) -> opaques()). +-type opaques_fun() :: fun((module()) -> [erl_types:erl_type()]). -type fun_types() :: dict:dict(label(), erl_types:type_table()). diff --git a/lib/dialyzer/src/dialyzer_coordinator.erl b/lib/dialyzer/src/dialyzer_coordinator.erl index 612f379d32..87cbd25b30 100644 --- a/lib/dialyzer/src/dialyzer_coordinator.erl +++ b/lib/dialyzer/src/dialyzer_coordinator.erl @@ -2,7 +2,7 @@ %%----------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2012. All Rights Reserved. +%% Copyright Ericsson AB 2006-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. @@ -29,8 +29,8 @@ %%% Export for dialyzer main process -export([parallel_job/4]). -%%% Exports for all possible workers --export([wait_activation/0, job_done/3]). +%%% Export for all possible workers +-export([job_done/3]). %%% Exports for the typesig and dataflow analysis workers -export([sccs_to_pids/2, request_activation/1]). @@ -38,7 +38,7 @@ %%% Exports for the compilation workers -export([get_next_label/2]). --export_type([coordinator/0, mode/0, init_data/0, result/0]). +-export_type([coordinator/0, mode/0, init_data/0, result/0, job/0]). %%-------------------------------------------------------------------- @@ -46,16 +46,18 @@ -type regulator() :: pid(). -type scc_to_pid() :: ets:tid() | 'unused'. --type coordinator() :: {collector(), regulator(), scc_to_pid()}. %%opaque +-opaque coordinator() :: {collector(), regulator(), scc_to_pid()}. -type timing() :: dialyzer_timing:timing_server(). -type scc() :: [mfa_or_funlbl()]. -type mode() :: 'typesig' | 'dataflow' | 'compile' | 'warnings'. --type compile_jobs() :: [file:filename()]. --type typesig_jobs() :: [scc()]. --type dataflow_jobs() :: [module()]. --type warnings_jobs() :: [module()]. +-type compile_job() :: file:filename(). +-type typesig_job() :: scc(). +-type dataflow_job() :: module(). +-type warnings_job() :: module(). + +-type job() :: compile_job() | typesig_job() | dataflow_job() | warnings_job(). -type compile_init_data() :: dialyzer_analysis_callgraph:compile_init_data(). -type typesig_init_data() :: dialyzer_succ_typings:typesig_init_data(). @@ -73,9 +75,9 @@ -type result() :: compile_result() | typesig_result() | dataflow_result() | warnings_result(). --type job() :: scc() | module() | file:filename(). --type job_result() :: dialyzer_analysis_callgraph:one_file_result() | - typesig_result() | dataflow_result() | warnings_result(). +-type job_result() :: dialyzer_analysis_callgraph:one_file_mid_error() | + dialyzer_analysis_callgraph:one_file_result_ok() | + typesig_result() | dataflow_result() | warnings_result(). -record(state, {mode :: mode(), active = 0 :: integer(), @@ -90,13 +92,13 @@ %%-------------------------------------------------------------------- --spec parallel_job('compile', compile_jobs(), compile_init_data(), timing()) -> +-spec parallel_job('compile', [compile_job()], compile_init_data(), timing()) -> {compile_result(), integer()}; - ('typesig', typesig_jobs(), typesig_init_data(), timing()) -> + ('typesig', [typesig_job()], typesig_init_data(), timing()) -> typesig_result(); - ('dataflow', dataflow_jobs(), dataflow_init_data(), + ('dataflow', [dataflow_job()], dataflow_init_data(), timing()) -> dataflow_result(); - ('warnings', warnings_jobs(), warnings_init_data(), + ('warnings', [warnings_job()], warnings_init_data(), timing()) -> warnings_result(). parallel_job(Mode, Jobs, InitData, Timing) -> @@ -118,7 +120,7 @@ spawn_jobs(Mode, Jobs, InitData, Timing) -> Pid = dialyzer_worker:launch(Mode, Job, InitData, Coordinator), case TypesigOrDataflow of true -> true = ets:insert(SCCtoPID, {Job, Pid}), ok; - false -> request_activation(Regulator, Pid) + false -> ok end, Count + 1 end, @@ -217,10 +219,6 @@ request_activation({_Collector, Regulator, _SCCtoPID}) -> Regulator ! {req, self()}, wait_activation(). -request_activation(Regulator, Pid) -> - Regulator ! {req, Pid}, - ok. - spawn_regulator() -> InitTickets = dialyzer_utils:parallelism(), spawn_link(fun() -> regulator_loop(InitTickets, queue:new()) end). diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index cabc5e9e0d..6e49043551 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -99,19 +99,29 @@ -define(BITS, 128). --record(state, {callgraph :: dialyzer_callgraph:callgraph(), - codeserver :: dialyzer_codeserver:codeserver(), - envs :: env_tab(), - fun_tab :: fun_tab(), - fun_homes :: dict:dict(label(), mfa()), - plt :: dialyzer_plt:plt(), - opaques :: [type()], +%% Types with comment 'race' are due to dialyzer_races.erl. +-record(state, {callgraph :: dialyzer_callgraph:callgraph() + | 'undefined', % race + codeserver :: dialyzer_codeserver:codeserver() + | 'undefined', % race + envs :: env_tab() + | 'undefined', % race + fun_tab :: fun_tab() + | 'undefined', % race + fun_homes :: dict:dict(label(), mfa()) + | 'undefined', % race + plt :: dialyzer_plt:plt() + | 'undefined', % race + opaques :: [type()] + | 'undefined', % race races = dialyzer_races:new() :: dialyzer_races:races(), records = dict:new() :: types(), - tree_map :: dict:dict(label(), cerl:cerl()), + tree_map :: dict:dict(label(), cerl:cerl()) + | 'undefined', % race warning_mode = false :: boolean(), warnings = [] :: [raw_warning()], - work :: {[_], [_], sets:set()}, + work :: {[_], [_], sets:set()} + | 'undefined', % race module :: module(), curr_fun :: curr_fun() }). diff --git a/lib/dialyzer/src/dialyzer_gui_wx.erl b/lib/dialyzer/src/dialyzer_gui_wx.erl index ff54a91ce1..9f344d87ff 100644 --- a/lib/dialyzer/src/dialyzer_gui_wx.erl +++ b/lib/dialyzer/src/dialyzer_gui_wx.erl @@ -2,7 +2,7 @@ %%------------------------------------------------------------------------ %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2013. All Rights Reserved. +%% Copyright Ericsson AB 2009-2015. 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. @@ -52,7 +52,6 @@ add_dir :: wx:wx_object(), add_rec :: wx:wx_object(), chosen_box :: wx:wx_object(), - analysis_pid :: pid(), del_file :: wx:wx_object(), doc_plt :: dialyzer_plt:plt(), clear_chosen :: wx:wx_object(), @@ -72,11 +71,11 @@ stop :: wx:wx_object(), frame :: wx:wx_object(), warnings_box :: wx:wx_object(), - explanation_box :: wx:wx_object(), + explanation_box :: wx:wx_object() | 'undefined', wantedWarnings :: list(), rawWarnings :: list(), - backend_pid :: pid(), - expl_pid :: pid()}). + backend_pid :: pid() | 'undefined', + expl_pid :: pid() | 'undefined'}). %%------------------------------------------------------------------------ diff --git a/lib/dialyzer/src/dialyzer_options.erl b/lib/dialyzer/src/dialyzer_options.erl index ce84c17f43..dd81dd01ed 100644 --- a/lib/dialyzer/src/dialyzer_options.erl +++ b/lib/dialyzer/src/dialyzer_options.erl @@ -72,9 +72,15 @@ preprocess_opts([Opt|Opts]) -> [Opt|preprocess_opts(Opts)]. postprocess_opts(Opts = #options{}) -> + check_file_existence(Opts), Opts1 = check_output_plt(Opts), adapt_get_warnings(Opts1). +check_file_existence(#options{analysis_type = plt_remove}) -> ok; +check_file_existence(#options{files = Files, files_rec = FilesRec}) -> + assert_filenames_exist(Files), + assert_filenames_exist(FilesRec). + check_output_plt(Opts = #options{analysis_type = Mode, from = From, output_plt = OutPLT}) -> case is_plt_mode(Mode) of @@ -126,14 +132,14 @@ build_options([{OptionName, Value} = Term|Rest], Options) -> apps -> OldValues = Options#options.files_rec, AppDirs = get_app_dirs(Value), - assert_filenames(Term, AppDirs), + assert_filenames_form(Term, AppDirs), build_options(Rest, Options#options{files_rec = AppDirs ++ OldValues}); files -> - assert_filenames(Term, Value), + assert_filenames_form(Term, Value), build_options(Rest, Options#options{files = Value}); files_rec -> OldValues = Options#options.files_rec, - assert_filenames(Term, Value), + assert_filenames_form(Term, Value), build_options(Rest, Options#options{files_rec = Value ++ OldValues}); analysis_type -> NewOptions = @@ -210,16 +216,26 @@ get_app_dirs(Apps) when is_list(Apps) -> get_app_dirs(Apps) -> bad_option("Use a list of otp applications", Apps). -assert_filenames(Term, [FileName|Left]) when length(FileName) >= 0 -> +assert_filenames(Term, Files) -> + assert_filenames_form(Term, Files), + assert_filenames_exist(Files). + +assert_filenames_form(Term, [FileName|Left]) when length(FileName) >= 0 -> + assert_filenames_form(Term, Left); +assert_filenames_form(_Term, []) -> + ok; +assert_filenames_form(Term, [_|_]) -> + bad_option("Malformed or non-existing filename", Term). + +assert_filenames_exist([FileName|Left]) -> case filelib:is_file(FileName) orelse filelib:is_dir(FileName) of true -> ok; - false -> bad_option("No such file, directory or application", FileName) + false -> + bad_option("No such file, directory or application", FileName) end, - assert_filenames(Term, Left); -assert_filenames(_Term, []) -> - ok; -assert_filenames(Term, [_|_]) -> - bad_option("Malformed or non-existing filename", Term). + assert_filenames_exist(Left); +assert_filenames_exist([]) -> + ok. assert_filename(FileName) when length(FileName) >= 0 -> ok; diff --git a/lib/dialyzer/src/dialyzer_plt.erl b/lib/dialyzer/src/dialyzer_plt.erl index 634871b2eb..769f26a3df 100644 --- a/lib/dialyzer/src/dialyzer_plt.erl +++ b/lib/dialyzer/src/dialyzer_plt.erl @@ -137,7 +137,7 @@ delete_list(#plt{info = Info, types = Types, #plt{info = table_delete_list(Info, List), types = Types, contracts = table_delete_list(Contracts, List), - callbacks = table_delete_list(Callbacks, List), + callbacks = Callbacks, exported_types = ExpTypes}. -spec insert_contract_list(plt(), dialyzer_contracts:plt_contracts()) -> plt(). diff --git a/lib/dialyzer/src/dialyzer_race_data_server.erl b/lib/dialyzer/src/dialyzer_race_data_server.erl new file mode 100644 index 0000000000..3600491809 --- /dev/null +++ b/lib/dialyzer/src/dialyzer_race_data_server.erl @@ -0,0 +1,134 @@ +%% -*- erlang-indent-level: 2 -*- +%%----------------------------------------------------------------------- +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2006-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% +%% + +%%%------------------------------------------------------------------- +%%% File : dialyzer_race_data_server.erl +%%% Author : Tobias Lindahl <[email protected]> +%%% Description : +%%% +%%% Created : 18 Sep 2015 by Luca Favatella <[email protected]> +%%%------------------------------------------------------------------- +-module(dialyzer_race_data_server). + +-export([new/0, + duplicate/1, + stop/1, + call/2, + cast/2]). + +-include("dialyzer.hrl"). + +%%---------------------------------------------------------------------- + +-record(state, {race_code = dict:new() :: dict:dict(), + public_tables = [] :: [label()], + named_tables = [] :: [string()], + beh_api_calls = [] :: [{mfa(), mfa()}]}). + +%%---------------------------------------------------------------------- + +-spec new() -> pid(). + +new() -> + spawn_link(fun() -> loop(#state{}) end). + +-spec duplicate(pid()) -> pid(). + +duplicate(Server) -> + call(dup, Server). + +-spec stop(pid()) -> ok. + +stop(Server) -> + cast(stop, Server). + +-spec call(atom(), pid()) -> term(). + +call(Query, Server) -> + Ref = make_ref(), + Server ! {call, self(), Ref, Query}, + receive + {Ref, Reply} -> Reply + end. + +-spec cast(atom() | {atom(), term()}, pid()) -> ok. + +cast(Message, Server) -> + Server ! {cast, Message}, + ok. + +%%---------------------------------------------------------------------- + +loop(State) -> + receive + {call, From, Ref, Query} -> + Reply = handle_call(Query, State), + From ! {Ref, Reply}, + loop(State); + {cast, stop} -> + ok; + {cast, Message} -> + NewState = handle_cast(Message, State), + loop(NewState) + end. + +handle_cast(race_code_new, State) -> + State#state{race_code = dict:new()}; +handle_cast({Tag, Data}, State) -> + case Tag of + renew_race_info -> renew_race_info_handler(Data, State); + renew_race_code -> renew_race_code_handler(Data, State); + renew_race_public_tables -> renew_race_public_tables_handler(Data, State); + put_race_code -> State#state{race_code = Data}; + put_public_tables -> State#state{public_tables = Data}; + put_named_tables -> State#state{named_tables = Data}; + put_behaviour_api_calls -> State#state{beh_api_calls = Data} + end. + +handle_call(Query, + #state{race_code = RaceCode, + public_tables = PublicTables, + named_tables = NamedTables, + beh_api_calls = BehApiCalls} + = State) -> + case Query of + dup -> spawn_link(fun() -> loop(State) end); + get_race_code -> RaceCode; + get_public_tables -> PublicTables; + get_named_tables -> NamedTables; + get_behaviour_api_calls -> BehApiCalls + end. + +%%---------------------------------------------------------------------- + +renew_race_info_handler({RaceCode, PublicTables, NamedTables}, + #state{} = State) -> + State#state{race_code = RaceCode, + public_tables = PublicTables, + named_tables = NamedTables}. + +renew_race_code_handler({Fun, FunArgs, Code}, + #state{race_code = RaceCode} = State) -> + State#state{race_code = dict:store(Fun, [FunArgs, Code], RaceCode)}. + +renew_race_public_tables_handler(VarLabel, + #state{public_tables = PT} = State) -> + State#state{public_tables = ordsets:add_element(VarLabel, PT)}. diff --git a/lib/dialyzer/src/dialyzer_races.erl b/lib/dialyzer/src/dialyzer_races.erl index 39de071bde..bb43d1dcb8 100644 --- a/lib/dialyzer/src/dialyzer_races.erl +++ b/lib/dialyzer/src/dialyzer_races.erl @@ -2,7 +2,7 @@ %%----------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2014. All Rights Reserved. +%% Copyright Ericsson AB 2008-2015. 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. @@ -92,27 +92,28 @@ -type race_warn_tag() :: ?WARN_WHEREIS_REGISTER | ?WARN_WHEREIS_UNREGISTER | ?WARN_ETS_LOOKUP_INSERT | ?WARN_MNESIA_DIRTY_READ_WRITE. --record(beg_clause, {arg :: var_to_map1(), - pats :: var_to_map1(), - guard :: cerl:cerl()}). --record(end_clause, {arg :: var_to_map1(), - pats :: var_to_map1(), - guard :: cerl:cerl()}). +-record(beg_clause, {arg :: var_to_map1() | 'undefined', + pats :: var_to_map1() | 'undefined', + guard :: cerl:cerl() | 'undefined'}). +-record(end_clause, {arg :: var_to_map1() | 'undefined', + pats :: var_to_map1() | 'undefined', + guard :: cerl:cerl() | 'undefined'}). -record(end_case, {clauses :: [#end_clause{}]}). --record(curr_fun, {status :: 'in' | 'out', - mfa :: dialyzer_callgraph:mfa_or_funlbl(), - label :: label(), - def_vars :: [core_vars()], - arg_types :: [erl_types:erl_type()], - call_vars :: [core_vars()], - var_map :: dict:dict()}). +-record(curr_fun, {status :: 'in' | 'out' | 'undefined', + mfa :: dialyzer_callgraph:mfa_or_funlbl() + | 'undefined', + label :: label() | 'undefined', + def_vars :: [core_vars()] | 'undefined', + arg_types :: [erl_types:erl_type()] | 'undefined', + call_vars :: [core_vars()] | 'undefined', + var_map :: dict:dict() | 'undefined'}). -record(dep_call, {call_name :: dep_calls(), - args :: args(), + args :: args() | 'undefined', arg_types :: [erl_types:erl_type()], vars :: [core_vars()], state :: dialyzer_dataflow:state(), file_line :: file_line(), - var_map :: dict:dict()}). + var_map :: dict:dict() | 'undefined'}). -record(fun_call, {caller :: dialyzer_callgraph:mfa_or_funlbl(), callee :: dialyzer_callgraph:mfa_or_funlbl(), arg_types :: [erl_types:erl_type()], @@ -121,7 +122,7 @@ arg :: var_to_map1()}). -record(warn_call, {call_name :: warn_calls(), args :: args(), - var_map :: dict:dict()}). + var_map :: dict:dict() | 'undefined'}). -type case_tags() :: 'beg_case' | #beg_clause{} | #end_clause{} | #end_case{}. -type code() :: [#dep_call{} | #fun_call{} | #warn_call{} | @@ -139,8 +140,9 @@ fun_mfa :: dialyzer_callgraph:mfa_or_funlbl(), fun_label :: label()}). --record(races, {curr_fun :: dialyzer_callgraph:mfa_or_funlbl(), - curr_fun_label :: label(), +-record(races, {curr_fun :: dialyzer_callgraph:mfa_or_funlbl() + | 'undefined', + curr_fun_label :: label() | 'undefined', curr_fun_args = 'empty' :: core_args(), new_table = 'no_t' :: table(), race_list = [] :: code(), diff --git a/lib/dialyzer/src/dialyzer_succ_typings.erl b/lib/dialyzer/src/dialyzer_succ_typings.erl index 18f02e6742..987da3aecf 100644 --- a/lib/dialyzer/src/dialyzer_succ_typings.erl +++ b/lib/dialyzer/src/dialyzer_succ_typings.erl @@ -2,7 +2,7 @@ %%----------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2014. All Rights Reserved. +%% Copyright Ericsson AB 2006-2015. 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. @@ -134,7 +134,6 @@ get_refined_success_typings(SCCs, #st{callgraph = Callgraph, end end. --type doc_plt() :: 'undefined' | dialyzer_plt:plt(). -spec get_warnings(dialyzer_callgraph:callgraph(), dialyzer_plt:plt(), doc_plt(), dialyzer_codeserver:codeserver(), dialyzer_timing:timing_server(), [solver()], pid()) -> diff --git a/lib/dialyzer/src/dialyzer_typesig.erl b/lib/dialyzer/src/dialyzer_typesig.erl index 0b8b244cc9..5f0881bbcd 100644 --- a/lib/dialyzer/src/dialyzer_typesig.erl +++ b/lib/dialyzer/src/dialyzer_typesig.erl @@ -68,7 +68,7 @@ -type type_var() :: erl_types:erl_type(). %% actually: {'c','var',_,_} -record(fun_var, {'fun' :: fun((_) -> erl_types:erl_type()), deps :: [dep()], - origin :: integer()}). + origin :: integer() | 'undefined'}). -type constr_op() :: 'eq' | 'sub'. -type fvar_or_type() :: #fun_var{} | erl_types:erl_type(). @@ -83,9 +83,9 @@ -record(constraint_list, {type :: 'conj' | 'disj', list :: [constr()], deps :: [dep()], - masks :: [{dep(),[non_neg_integer()]}] | - {'d',dict:dict(dep(), [non_neg_integer()])}, - id :: {'list', dep()}}). + masks = [] :: [{dep(),[non_neg_integer()]}] | + {'d',dict:dict(dep(), [non_neg_integer()])}, + id :: {'list', dep()} | 'undefined'}). -type constraint_list() :: #constraint_list{}. @@ -104,7 +104,8 @@ -type dict_or_ets() :: {'d', prop_types()} | {'e', ets:tid()}. --record(state, {callgraph :: dialyzer_callgraph:callgraph(), +-record(state, {callgraph :: dialyzer_callgraph:callgraph() + | 'undefined', cs = [] :: [constr()], cmap = {'d', dict:new()} :: dict_or_ets(), fun_map = [] :: typesig_funmap(), @@ -116,7 +117,8 @@ cerl:c_fun()), next_label = 0 :: label(), self_rec :: 'false' | erl_types:erl_type(), - plt :: dialyzer_plt:plt(), + plt :: dialyzer_plt:plt() + | 'undefined', prop_types = {'d', dict:new()} :: dict_or_ets(), records = dict:new() :: types(), scc = [] :: [type_var()], @@ -1746,7 +1748,10 @@ minimize_state(#state{ fun_arities = FunArities, self_rec = SelfRec, prop_types = {e, ETSPropTypes}, - solvers = Solvers + solvers = Solvers, + callgraph = undefined, + plt = undefined, + mfas = [] }. dispose_state(#state{cmap = {e, ETSCMap}, @@ -2884,8 +2889,7 @@ mk_constraint(Lhs, Op, Rhs) -> case t_is_any(Lhs) orelse constraint_opnd_is_any(Rhs) of false -> Deps = find_constraint_deps([Lhs, Rhs]), - C0 = mk_constraint_1(Lhs, Op, Rhs), - C = C0#constraint{deps = Deps}, + C = mk_constraint_1(Lhs, Op, Rhs, Deps), case Deps =:= [] of true -> %% This constraint is constant. Solve it immediately. @@ -2903,8 +2907,7 @@ mk_constraint(Lhs, Op, Rhs) -> end. mk_constraint_any(Op) -> - C = mk_constraint_1(t_any(), Op, t_any()), - C#constraint{deps = []}. + mk_constraint_1(t_any(), Op, t_any(), []). %% the following function is used so that we do not call %% erl_types:t_is_any/1 with a term other than an erl_type() @@ -2952,12 +2955,12 @@ find_constraint_deps([Type|Tail], Acc) -> find_constraint_deps([], Acc) -> lists:flatten(Acc). -mk_constraint_1(Lhs, eq, Rhs) when Lhs < Rhs -> - #constraint{lhs = Lhs, op = eq, rhs = Rhs}; -mk_constraint_1(Lhs, eq, Rhs) -> - #constraint{lhs = Rhs, op = eq, rhs = Lhs}; -mk_constraint_1(Lhs, Op, Rhs) -> - #constraint{lhs = Lhs, op = Op, rhs = Rhs}. +mk_constraint_1(Lhs, eq, Rhs, Deps) when Lhs < Rhs -> + #constraint{lhs = Lhs, op = eq, rhs = Rhs, deps = Deps}; +mk_constraint_1(Lhs, eq, Rhs, Deps) -> + #constraint{lhs = Rhs, op = eq, rhs = Lhs, deps = Deps}; +mk_constraint_1(Lhs, Op, Rhs, Deps) -> + #constraint{lhs = Lhs, op = Op, rhs = Rhs, deps = Deps}. mk_constraints([Lhs|LhsTail], Op, [Rhs|RhsTail]) -> [mk_constraint(Lhs, Op, Rhs) | diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl index 7fe982a992..5fc1c0e691 100644 --- a/lib/dialyzer/src/dialyzer_utils.erl +++ b/lib/dialyzer/src/dialyzer_utils.erl @@ -2,7 +2,7 @@ %%----------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2015. All Rights Reserved. +%% Copyright Ericsson AB 2006-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. @@ -83,7 +83,7 @@ print_types1([{record, _Name} = Key|T], RecDict) -> %% ---------------------------------------------------------------------------- --type abstract_code() :: [tuple()]. %% XXX: import from somewhere +-type abstract_code() :: [erl_parse:abstract_form()]. -type comp_options() :: [compile:option()]. -type mod_or_fname() :: module() | file:filename(). -type fa() :: {atom(), arity()}. @@ -297,8 +297,8 @@ get_record_fields([], _RecDict, Acc) -> %% The field types are cached. Used during analysis when handling records. process_record_remote_types(CServer) -> TempRecords = dialyzer_codeserver:get_temp_records(CServer), - TempExpTypes = dialyzer_codeserver:get_temp_exported_types(CServer), - TempRecords1 = process_opaque_types0(TempRecords, TempExpTypes), + ExpTypes = dialyzer_codeserver:get_exported_types(CServer), + TempRecords1 = process_opaque_types0(TempRecords, ExpTypes), ModuleFun = fun(Module, Record) -> RecordFun = @@ -310,7 +310,7 @@ process_record_remote_types(CServer) -> Site = {record, {Module, Name, Arity}}, [{FieldName, Field, erl_types:t_from_form(Field, - TempExpTypes, + ExpTypes, Site, TempRecords1)} || {FieldName, Field, _} <- Fields] @@ -323,9 +323,8 @@ process_record_remote_types(CServer) -> dict:map(RecordFun, Record) end, NewRecords = dict:map(ModuleFun, TempRecords1), - ok = check_record_fields(NewRecords, TempExpTypes), - CServer1 = dialyzer_codeserver:finalize_records(NewRecords, CServer), - dialyzer_codeserver:finalize_exported_types(TempExpTypes, CServer1). + ok = check_record_fields(NewRecords, ExpTypes), + dialyzer_codeserver:finalize_records(NewRecords, CServer). %% erl_types:t_from_form() substitutes the declaration of opaque types %% for the expanded type in some cases. To make sure the initial type, diff --git a/lib/dialyzer/src/dialyzer_worker.erl b/lib/dialyzer/src/dialyzer_worker.erl index 4be93c75bf..b9ab27c11d 100644 --- a/lib/dialyzer/src/dialyzer_worker.erl +++ b/lib/dialyzer/src/dialyzer_worker.erl @@ -2,7 +2,7 @@ %%----------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2012. All Rights Reserved. +%% Copyright Ericsson AB 2006-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. @@ -21,20 +21,20 @@ -module(dialyzer_worker). --export([launch/4, sequential/4]). +-export([launch/4]). -export_type([worker/0]). --type worker() :: pid(). %%opaque +-opaque worker() :: pid(). -type mode() :: dialyzer_coordinator:mode(). -type coordinator() :: dialyzer_coordinator:coordinator(). -type init_data() :: dialyzer_coordinator:init_data(). --type result() :: dialyzer_coordinator:result(). +-type job() :: dialyzer_coordinator:job(). -record(state, { mode :: mode(), - job :: mfa_or_funlbl() | file:filename(), + job :: job(), coordinator :: coordinator(), init_data :: init_data(), depends_on = [] :: list() @@ -52,23 +52,28 @@ %%-------------------------------------------------------------------- --spec launch(mode(), [mfa_or_funlbl()], init_data(), coordinator()) -> worker(). +-spec launch(mode(), job(), init_data(), coordinator()) -> worker(). launch(Mode, Job, InitData, Coordinator) -> State = #state{mode = Mode, job = Job, init_data = InitData, coordinator = Coordinator}, - InitState = - case Mode of - X when X =:= 'typesig'; X =:= 'dataflow' -> initializing; - X when X =:= 'compile'; X =:= 'warnings' -> running - end, - spawn_link(fun() -> loop(InitState, State) end). + spawn_link(fun() -> init(State) end). %%-------------------------------------------------------------------- -loop(updating, State) -> +init(#state{job = SCC, mode = Mode, init_data = InitData} = State) when + Mode =:= 'typesig'; Mode =:= 'dataflow' -> + DependsOn = dialyzer_succ_typings:find_depends_on(SCC, InitData), + ?debug("Deps ~p: ~p\n",[SCC, DependsOn]), + loop(updating, State#state{depends_on = DependsOn}); +init(#state{mode = Mode} = State) when + Mode =:= 'compile'; Mode =:= 'warnings' -> + loop(running, State). + +loop(updating, #state{mode = Mode} = State) when + Mode =:= 'typesig'; Mode =:= 'dataflow' -> ?debug("Update: ~p\n",[State#state.job]), NextStatus = case waits_more_success_typings(State) of @@ -76,16 +81,13 @@ loop(updating, State) -> false -> running end, loop(NextStatus, State); -loop(initializing, #state{job = SCC, init_data = InitData} = State) -> - DependsOn = dialyzer_succ_typings:find_depends_on(SCC, InitData), - ?debug("Deps ~p: ~p\n",[State#state.job, DependsOn]), - loop(updating, State#state{depends_on = DependsOn}); -loop(waiting, State) -> +loop(waiting, #state{mode = Mode} = State) when + Mode =:= 'typesig'; Mode =:= 'dataflow' -> ?debug("Wait: ~p\n",[State#state.job]), NewState = wait_for_success_typings(State), loop(updating, NewState); loop(running, #state{mode = 'compile'} = State) -> - dialyzer_coordinator:wait_activation(), + dialyzer_coordinator:request_activation(State#state.coordinator), ?debug("Compile: ~s\n",[State#state.job]), Result = case start_compilation(State) of @@ -97,7 +99,7 @@ loop(running, #state{mode = 'compile'} = State) -> end, report_to_coordinator(Result, State); loop(running, #state{mode = 'warnings'} = State) -> - dialyzer_coordinator:wait_activation(), + dialyzer_coordinator:request_activation(State#state.coordinator), ?debug("Warning: ~s\n",[State#state.job]), Result = collect_warnings(State), report_to_coordinator(Result, State); @@ -169,22 +171,3 @@ continue_compilation(Label, Data) -> collect_warnings(#state{job = Job, init_data = InitData}) -> dialyzer_succ_typings:collect_warnings(Job, InitData). - -%%------------------------------------------------------------------------------ - --type extra() :: label() | 'unused'. - --spec sequential(mode(), [mfa_or_funlbl()], init_data(), extra()) -> result(). - -sequential('compile', Job, InitData, Extra) -> - case dialyzer_analysis_callgraph:start_compilation(Job, InitData) of - {ok, EstimatedSize, Data} -> - {EstimatedSize, continue_compilation(Extra, Data)}; - {error, _Reason} = Error -> {0, Error} - end; -sequential('typesig', Job, InitData, _Extra) -> - dialyzer_succ_typings:find_succ_types_for_scc(Job, InitData); -sequential('dataflow', Job, InitData, _Extra) -> - dialyzer_succ_typings:refine_one_module(Job, InitData); -sequential('warnings', Job, InitData, _Extra) -> - dialyzer_succ_typings:collect_warnings(Job, InitData). diff --git a/lib/dialyzer/test/behaviour_SUITE_data/results/callbacks_and_specs b/lib/dialyzer/test/behaviour_SUITE_data/results/callbacks_and_specs index 33d135048e..38999e8919 100644 --- a/lib/dialyzer/test/behaviour_SUITE_data/results/callbacks_and_specs +++ b/lib/dialyzer/test/behaviour_SUITE_data/results/callbacks_and_specs @@ -1,5 +1,5 @@ -my_callbacks_wrong.erl:26: The return type #state{parent::'undefined' | pid(),status::'closed' | 'init' | 'open',subscribe::[{pid(),integer()}],counter::integer()} in the specification of callback_init/1 is not a subtype of {'ok',_}, which is the expected return type for the callback of my_behaviour behaviour -my_callbacks_wrong.erl:28: The inferred return type of callback_init/1 (#state{parent::'undefined' | pid(),status::'init',subscribe::[],counter::1}) has nothing in common with {'ok',_}, which is the expected return type for the callback of my_behaviour behaviour -my_callbacks_wrong.erl:30: The return type {'reply',#state{parent::'undefined' | pid(),status::'closed' | 'init' | 'open',subscribe::[{pid(),integer()}],counter::integer()}} in the specification of callback_cast/3 is not a subtype of {'noreply',_}, which is the expected return type for the callback of my_behaviour behaviour +my_callbacks_wrong.erl:26: The return type #state{parent::pid(),status::'closed' | 'init' | 'open',subscribe::[{pid(),integer()}],counter::integer()} in the specification of callback_init/1 is not a subtype of {'ok',_}, which is the expected return type for the callback of my_behaviour behaviour +my_callbacks_wrong.erl:28: The inferred return type of callback_init/1 (#state{parent::pid(),status::'init',subscribe::[],counter::1}) has nothing in common with {'ok',_}, which is the expected return type for the callback of my_behaviour behaviour +my_callbacks_wrong.erl:30: The return type {'reply',#state{parent::pid(),status::'closed' | 'init' | 'open',subscribe::[{pid(),integer()}],counter::integer()}} in the specification of callback_cast/3 is not a subtype of {'noreply',_}, which is the expected return type for the callback of my_behaviour behaviour my_callbacks_wrong.erl:39: The specified type for the 2nd argument of callback_call/3 (atom()) is not a supertype of pid(), which is expected type for this argument in the callback of the my_behaviour behaviour diff --git a/lib/dialyzer/test/behaviour_SUITE_data/results/supervisor_incorrect_return b/lib/dialyzer/test/behaviour_SUITE_data/results/supervisor_incorrect_return index 4103a2d8b4..89eb295604 100644 --- a/lib/dialyzer/test/behaviour_SUITE_data/results/supervisor_incorrect_return +++ b/lib/dialyzer/test/behaviour_SUITE_data/results/supervisor_incorrect_return @@ -1,2 +1,2 @@ -supervisor_incorrect_return.erl:14: The inferred return type of init/1 ({'ok',{{'one_against_one',0,1},[{_,_,_,_,_,_},...]}}) has nothing in common with 'ignore' | {'ok',{{'one_for_all',non_neg_integer(),pos_integer()} | {'one_for_one',non_neg_integer(),pos_integer()} | {'rest_for_one',non_neg_integer(),pos_integer()} | {'simple_one_for_one',non_neg_integer(),pos_integer()} | #{},[{_,{atom() | tuple(),atom(),'undefined' | [any()]},'permanent' | 'temporary' | 'transient','brutal_kill' | 'infinity' | non_neg_integer(),'supervisor' | 'worker','dynamic' | [atom() | tuple()]} | #{}]}}, which is the expected return type for the callback of supervisor behaviour +supervisor_incorrect_return.erl:14: The inferred return type of init/1 ({'ok',{{'one_against_one',0,1},[{_,_,_,_,_,_},...]}}) has nothing in common with 'ignore' | {'ok',{{'one_for_all',non_neg_integer(),pos_integer()} | {'one_for_one',non_neg_integer(),pos_integer()} | {'rest_for_one',non_neg_integer(),pos_integer()} | {'simple_one_for_one',non_neg_integer(),pos_integer()} | #{},[{_,{atom(),atom(),'undefined' | [any()]},'permanent' | 'temporary' | 'transient','brutal_kill' | 'infinity' | non_neg_integer(),'supervisor' | 'worker','dynamic' | [atom()]} | #{}]}}, which is the expected return type for the callback of supervisor behaviour diff --git a/lib/dialyzer/test/dialyzer_SUITE.erl b/lib/dialyzer/test/dialyzer_SUITE.erl index 80f4508ec6..8a2324a7c2 100644 --- a/lib/dialyzer/test/dialyzer_SUITE.erl +++ b/lib/dialyzer/test/dialyzer_SUITE.erl @@ -19,7 +19,7 @@ %% -module(dialyzer_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Default timetrap timeout (set in init_per_testcase). -define(default_timeout, ?t:minutes(1)). diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/crash b/lib/dialyzer/test/opaque_SUITE_data/results/crash index 69bdc00257..d63389f79c 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/results/crash +++ b/lib/dialyzer/test/opaque_SUITE_data/results/crash @@ -1,6 +1,6 @@ -crash_1.erl:45: Record construction #targetlist{list::[]} violates the declared type of field list::'undefined' | crash_1:target() -crash_1.erl:48: The call crash_1:get_using_branch2(Branch::maybe_improper_list(),L::'undefined' | crash_1:target()) will never return since it differs in the 2nd argument from the success typing arguments: (any(),maybe_improper_list()) -crash_1.erl:50: The pattern <_Branch, []> can never match the type <maybe_improper_list(),'undefined' | crash_1:target()> -crash_1.erl:52: The pattern <Branch, [H = {'target', _, _} | _T]> can never match the type <maybe_improper_list(),'undefined' | crash_1:target()> -crash_1.erl:54: The pattern <Branch, [{'target', _, _} | T]> can never match the type <maybe_improper_list(),'undefined' | crash_1:target()> +crash_1.erl:45: Record construction #targetlist{list::[]} violates the declared type of field list::crash_1:target() +crash_1.erl:48: The call crash_1:get_using_branch2(Branch::maybe_improper_list(),L::crash_1:target()) will never return since it differs in the 2nd argument from the success typing arguments: (any(),maybe_improper_list()) +crash_1.erl:50: The pattern <_Branch, []> can never match the type <maybe_improper_list(),crash_1:target()> +crash_1.erl:52: The pattern <Branch, [H = {'target', _, _} | _T]> can never match the type <maybe_improper_list(),crash_1:target()> +crash_1.erl:54: The pattern <Branch, [{'target', _, _} | T]> can never match the type <maybe_improper_list(),crash_1:target()> diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/simple b/lib/dialyzer/test/opaque_SUITE_data/results/simple index 1a7a139d6e..391c37664e 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/results/simple +++ b/lib/dialyzer/test/opaque_SUITE_data/results/simple @@ -18,7 +18,7 @@ rec_api.erl:104: Matching of pattern {'r2', 10} tagged with a record name violat rec_api.erl:113: The attempt to match a term of type #r3{f1::queue:queue(_)} against the pattern {'r3', 'a'} breaks the opaqueness of queue:queue(_) rec_api.erl:118: Record construction #r3{f1::10} violates the declared type of field f1::queue:queue(_) rec_api.erl:123: The attempt to match a term of type #r3{f1::10} against the pattern {'r3', 10} breaks the opaqueness of queue:queue(_) -rec_api.erl:24: Record construction #r1{f1::10} violates the declared type of field f1::'undefined' | rec_api:a() +rec_api.erl:24: Record construction #r1{f1::10} violates the declared type of field f1::rec_api:a() rec_api.erl:29: Matching of pattern {'r1', 10} tagged with a record name violates the declared type of #r1{f1::10} rec_api.erl:33: The attempt to match a term of type rec_adt:r1() against the pattern {'r1', 'a'} breaks the opaqueness of the term rec_api.erl:35: Invalid type specification for function rec_api:adt_t1/1. The success typing is (#r1{f1::'a'}) -> #r1{f1::'a'} @@ -70,8 +70,8 @@ simple1_api.erl:478: The call 'foo':A(A::simple1_adt:a()) breaks the opaqueness simple1_api.erl:486: The call A:'foo'(A::simple1_adt:a()) breaks the opaqueness of the term A :: simple1_adt:a() simple1_api.erl:499: The call 'foo':A(A::simple1_api:i()) requires that A is of type atom() not simple1_api:i() simple1_api.erl:503: The call 'foo':A(A::simple1_adt:i()) requires that A is of type atom() not simple1_adt:i() -simple1_api.erl:507: The call A:'foo'(A::simple1_api:i()) requires that A is of type atom() | tuple() not simple1_api:i() -simple1_api.erl:511: The call A:'foo'(A::simple1_adt:i()) requires that A is of type atom() | tuple() not simple1_adt:i() +simple1_api.erl:507: The call A:'foo'(A::simple1_api:i()) requires that A is of type atom() not simple1_api:i() +simple1_api.erl:511: The call A:'foo'(A::simple1_adt:i()) requires that A is of type atom() not simple1_adt:i() simple1_api.erl:519: Guard test A::simple1_adt:d2() == B::simple1_adt:d1() contains opaque terms as 1st and 2nd arguments simple1_api.erl:534: Guard test A::simple1_adt:d1() >= 3 contains an opaque term as 1st argument simple1_api.erl:536: Guard test A::simple1_adt:d1() == 3 contains an opaque term as 1st argument diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/proper/proper_typeserver.erl b/lib/dialyzer/test/opaque_SUITE_data/src/proper/proper_typeserver.erl index b6cab5e24b..1677b4efb8 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/src/proper/proper_typeserver.erl +++ b/lib/dialyzer/test/opaque_SUITE_data/src/proper/proper_typeserver.erl @@ -781,7 +781,8 @@ add_mod_info({attribute,_Line,record,{RecName,Fields}}, true -> ModInfo; false -> - TypedRecord = {attribute,0,type,{{record,RecName},Fields,[]}}, + A = erl_anno:new(0), + TypedRecord = {attribute,A,type,{{record,RecName},Fields,[]}}, add_mod_info(TypedRecord, ModInfo) end; add_mod_info({attribute,_Line,Kind,{Name,TypeForm,VarForms}}, diff --git a/lib/dialyzer/test/plt_SUITE.erl b/lib/dialyzer/test/plt_SUITE.erl index ecbac14e5d..6ebe23b54b 100644 --- a/lib/dialyzer/test/plt_SUITE.erl +++ b/lib/dialyzer/test/plt_SUITE.erl @@ -7,12 +7,14 @@ -include("dialyzer_test_constants.hrl"). -export([suite/0, all/0, build_plt/1, beam_tests/1, update_plt/1, - run_plt_check/1, run_succ_typings/1]). + local_fun_same_as_callback/1, + remove_plt/1, run_plt_check/1, run_succ_typings/1]). suite() -> [{timetrap, ?plt_timeout}]. -all() -> [build_plt, beam_tests, update_plt, run_plt_check, run_succ_typings]. +all() -> [build_plt, beam_tests, update_plt, run_plt_check, + remove_plt, run_succ_typings, local_fun_same_as_callback]. build_plt(Config) -> OutDir = ?config(priv_dir, Config), @@ -158,6 +160,95 @@ update_plt(Config) -> {init_plt, Plt}] ++ Opts), ok. +%%% If a behaviour module contains an non-exported function with the same name +%%% as one of the behaviour's callbacks, the callback info was inadvertently +%%% deleted from the PLT as the dialyzer_plt:delete_list/2 function was cleaning +%%% up the callback table. This bug was reported by Brujo Benavides. + +local_fun_same_as_callback(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + Prog1 = + <<"-module(bad_behaviour). + -callback bad() -> bad. + -export([publicly_bad/0]). + + %% @doc This function is here just to avoid the 'unused' warning for bad/0 + publicly_bad() -> bad(). + + %% @doc This function overlaps with the callback with the same name, and + %% that was an issue for dialyzer since it's a private function. + bad() -> bad.">>, + {ok, Beam} = compile(Config, Prog1, bad_behaviour, []), + + ErlangBeam = case code:where_is_file("erlang.beam") of + non_existing -> + filename:join([code:root_dir(), + "erts", "preloaded", "ebin", + "erlang.beam"]); + EBeam -> + EBeam + end, + Plt = filename:join(PrivDir, "plt_bad_behaviour.plt"), + Opts = [{check_plt, true}, {from, byte_code}], + [] = dialyzer:run([{analysis_type, plt_build}, + {files, [Beam, ErlangBeam]}, + {output_plt, Plt}] ++ Opts), + + Prog2 = + <<"-module(bad_child). + -behaviour(bad_behaviour). + + -export([bad/0]). + + %% @doc This function incorreclty implements bad_behaviour. + bad() -> not_bad.">>, + {ok, TestBeam} = compile(Config, Prog2, bad_child, []), + + [{warn_behaviour, _, + {callback_type_mismatch, + [bad_behaviour,bad,0,"'not_bad'","'bad'"]}}] = + dialyzer:run([{analysis_type, succ_typings}, + {files, [TestBeam]}, + {init_plt, Plt}] ++ Opts), + ok. + +%%% [James Fish:] +%%% Dialyzer always asserts that files and directories passed in its +%%% options exist. Therefore it is not possible to remove a beam/module +%%% from a PLT when the beam file no longer exists. Dialyzer should not to +%%% check files exist on disk when removing from the PLT. +remove_plt(Config) -> + PrivDir = ?config(priv_dir, Config), + Prog1 = <<"-module(m1). + -export([t/0]). + t() -> + m2:a(a).">>, + {ok, Beam1} = compile(Config, Prog1, m1, []), + + Prog2 = <<"-module(m2). + -export([a/1]). + a(A) when is_integer(A) -> A.">>, + {ok, Beam2} = compile(Config, Prog2, m2, []), + + Plt = filename:join(PrivDir, "remove.plt"), + Opts = [{check_plt, true}, {from, byte_code}], + + [{warn_return_no_exit, _, {no_return,[only_normal,t,0]}}, + {warn_failing_call, _, {call, [m2,a,"('a')",_,_,_,_,_]}}] = + dialyzer:run([{analysis_type, plt_build}, + {files, [Beam1, Beam2]}, + {get_warnings, true}, + {output_plt, Plt}] ++ Opts), + + [] = dialyzer:run([{init_plt, Plt}, + {files, [Beam2]}, + {analysis_type, plt_remove}]), + + [] = dialyzer:run([{analysis_type, succ_typings}, + {files, [Beam1]}, + {init_plt, Plt}] ++ Opts), + ok. + compile(Config, Prog, Module, CompileOpts) -> Source = lists:concat([Module, ".erl"]), PrivDir = ?config(priv_dir,Config), diff --git a/lib/dialyzer/test/r9c_SUITE_data/results/mnesia b/lib/dialyzer/test/r9c_SUITE_data/results/mnesia index b73943422a..bf67447ee7 100644 --- a/lib/dialyzer/test/r9c_SUITE_data/results/mnesia +++ b/lib/dialyzer/test/r9c_SUITE_data/results/mnesia @@ -6,7 +6,7 @@ mnesia_bup.erl:111: The created fun has no local return mnesia_bup.erl:574: Function fallback_receiver/2 has no local return mnesia_bup.erl:967: Function uninstall_fallback_master/2 has no local return mnesia_checkpoint.erl:1014: The variable Error can never match since previous clauses completely covered the type {'ok',#checkpoint_args{nodes::[any()],retainers::[any(),...]}} -mnesia_checkpoint.erl:894: The call sys:handle_system_msg(Msg::any(),From::any(),'no_parent','mnesia_checkpoint',[],Cp::#checkpoint_args{}) breaks the contract (Msg,From,Parent,Module,Debug,Misc) -> no_return() when is_subtype(Msg,term()), is_subtype(From,{pid(),Tag::_}), is_subtype(Parent,pid()), is_subtype(Module,module()), is_subtype(Debug,[dbg_opt()]), is_subtype(Misc,term()) +mnesia_checkpoint.erl:894: The call sys:handle_system_msg(Msg::any(),From::any(),'no_parent','mnesia_checkpoint',[],Cp::#checkpoint_args{}) breaks the contract (Msg,From,Parent,Module,Debug,Misc) -> no_return() when Msg :: term(), From :: {pid(),Tag::_}, Parent :: pid(), Module :: module(), Debug :: [dbg_opt()], Misc :: term() mnesia_controller.erl:1666: The variable Tab can never match since previous clauses completely covered the type [any()] mnesia_controller.erl:1679: The pattern {'stop', Reason, Reply, State2} can never match the type {'noreply',_} | {'reply',_,_} | {'stop','shutdown',#state{}} mnesia_controller.erl:1685: The pattern {'noreply', State2, _Timeout} can never match the type {'reply',_,_} @@ -35,6 +35,6 @@ mnesia_schema.erl:1258: Guard test FromS::'disc_copies' | 'disc_only_copies' | ' mnesia_schema.erl:1639: The pattern {'false', 'mandatory'} can never match the type {'false','optional'} mnesia_schema.erl:2434: The variable Reason can never match since previous clauses completely covered the type {'error',_} | {'ok',_} mnesia_schema.erl:451: Guard test UseDirAnyway::'false' == 'true' can never succeed -mnesia_text.erl:180: The variable T can never match since previous clauses completely covered the type {'error',{integer(),atom() | tuple(),_}} | {'ok',_} +mnesia_text.erl:180: The variable T can never match since previous clauses completely covered the type {'error',{non_neg_integer(),atom(),_}} | {'ok',_} mnesia_tm.erl:1522: Function commit_participant/5 has no local return mnesia_tm.erl:2169: Function system_terminate/4 has no local return diff --git a/lib/dialyzer/test/small_SUITE_data/results/app_call b/lib/dialyzer/test/small_SUITE_data/results/app_call index cc1a63f944..1af649815a 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/app_call +++ b/lib/dialyzer/test/small_SUITE_data/results/app_call @@ -1,3 +1,3 @@ -app_call.erl:6: The call M:'foo'() requires that M is of type atom() | tuple() not 42 +app_call.erl:6: The call M:'foo'() requires that M is of type atom() not 42 app_call.erl:9: The call 'mod':F() requires that F is of type atom() not {'gazonk',[]} diff --git a/lib/dialyzer/test/small_SUITE_data/results/bif1 b/lib/dialyzer/test/small_SUITE_data/results/bif1 new file mode 100644 index 0000000000..289b6f821f --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/bif1 @@ -0,0 +1,3 @@ + +bif1.erl:13: Function string_chars/0 has no local return +bif1.erl:16: The call string:chars(S::65,10,L2::bif1_adt:s()) contains an opaque term as 3rd argument when terms of different types are expected in these positions diff --git a/lib/dialyzer/test/small_SUITE_data/results/comparisons b/lib/dialyzer/test/small_SUITE_data/results/comparisons index 642585d25e..5083d2695a 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/comparisons +++ b/lib/dialyzer/test/small_SUITE_data/results/comparisons @@ -1,50 +1,43 @@ comparisons.erl:100: The pattern 'true' can never match the type 'false' -comparisons.erl:101: The pattern 'true' can never match the type 'false' +comparisons.erl:101: The pattern 'false' can never match the type 'true' comparisons.erl:102: The pattern 'false' can never match the type 'true' -comparisons.erl:103: The pattern 'false' can never match the type 'true' +comparisons.erl:103: The pattern 'true' can never match the type 'false' comparisons.erl:104: The pattern 'true' can never match the type 'false' -comparisons.erl:105: The pattern 'true' can never match the type 'false' -comparisons.erl:107: The pattern 'true' can never match the type 'false' -comparisons.erl:108: The pattern 'true' can never match the type 'false' -comparisons.erl:109: The pattern 'false' can never match the type 'true' -comparisons.erl:110: The pattern 'false' can never match the type 'true' -comparisons.erl:111: The pattern 'true' can never match the type 'false' -comparisons.erl:112: The pattern 'true' can never match the type 'false' -comparisons.erl:113: The pattern 'false' can never match the type 'true' -comparisons.erl:114: The pattern 'false' can never match the type 'true' -comparisons.erl:115: The pattern 'true' can never match the type 'false' -comparisons.erl:116: The pattern 'true' can never match the type 'false' -comparisons.erl:117: The pattern 'false' can never match the type 'true' comparisons.erl:118: The pattern 'false' can never match the type 'true' +comparisons.erl:119: The pattern 'false' can never match the type 'true' +comparisons.erl:120: The pattern 'true' can never match the type 'false' +comparisons.erl:121: The pattern 'true' can never match the type 'false' +comparisons.erl:122: The pattern 'false' can never match the type 'true' comparisons.erl:123: The pattern 'false' can never match the type 'true' -comparisons.erl:124: The pattern 'false' can never match the type 'true' +comparisons.erl:124: The pattern 'true' can never match the type 'false' comparisons.erl:125: The pattern 'true' can never match the type 'false' -comparisons.erl:126: The pattern 'true' can never match the type 'false' +comparisons.erl:126: The pattern 'false' can never match the type 'true' comparisons.erl:127: The pattern 'false' can never match the type 'true' -comparisons.erl:128: The pattern 'false' can never match the type 'true' +comparisons.erl:128: The pattern 'true' can never match the type 'false' comparisons.erl:129: The pattern 'true' can never match the type 'false' -comparisons.erl:130: The pattern 'true' can never match the type 'false' +comparisons.erl:130: The pattern 'false' can never match the type 'true' +comparisons.erl:131: The pattern 'false' can never match the type 'true' comparisons.erl:132: The pattern 'true' can never match the type 'false' comparisons.erl:133: The pattern 'true' can never match the type 'false' comparisons.erl:134: The pattern 'false' can never match the type 'true' comparisons.erl:135: The pattern 'false' can never match the type 'true' comparisons.erl:136: The pattern 'true' can never match the type 'false' comparisons.erl:137: The pattern 'true' can never match the type 'false' -comparisons.erl:138: The pattern 'false' can never match the type 'true' -comparisons.erl:139: The pattern 'false' can never match the type 'true' +comparisons.erl:139: The pattern 'true' can never match the type 'false' comparisons.erl:140: The pattern 'true' can never match the type 'false' -comparisons.erl:141: The pattern 'true' can never match the type 'false' +comparisons.erl:141: The pattern 'false' can never match the type 'true' comparisons.erl:142: The pattern 'false' can never match the type 'true' -comparisons.erl:143: The pattern 'false' can never match the type 'true' +comparisons.erl:143: The pattern 'true' can never match the type 'false' comparisons.erl:144: The pattern 'true' can never match the type 'false' -comparisons.erl:145: The pattern 'true' can never match the type 'false' +comparisons.erl:145: The pattern 'false' can never match the type 'true' comparisons.erl:146: The pattern 'false' can never match the type 'true' -comparisons.erl:147: The pattern 'false' can never match the type 'true' -comparisons.erl:152: The pattern 'false' can never match the type 'true' -comparisons.erl:153: The pattern 'false' can never match the type 'true' -comparisons.erl:154: The pattern 'true' can never match the type 'false' -comparisons.erl:155: The pattern 'true' can never match the type 'false' +comparisons.erl:147: The pattern 'true' can never match the type 'false' +comparisons.erl:148: The pattern 'true' can never match the type 'false' +comparisons.erl:149: The pattern 'false' can never match the type 'true' +comparisons.erl:150: The pattern 'false' can never match the type 'true' +comparisons.erl:155: The pattern 'false' can never match the type 'true' +comparisons.erl:156: The pattern 'false' can never match the type 'true' comparisons.erl:157: The pattern 'true' can never match the type 'false' comparisons.erl:158: The pattern 'true' can never match the type 'false' comparisons.erl:159: The pattern 'false' can never match the type 'true' @@ -59,36 +52,62 @@ comparisons.erl:167: The pattern 'false' can never match the type 'true' comparisons.erl:168: The pattern 'false' can never match the type 'true' comparisons.erl:169: The pattern 'true' can never match the type 'false' comparisons.erl:170: The pattern 'true' can never match the type 'false' -comparisons.erl:171: The pattern 'false' can never match the type 'true' -comparisons.erl:172: The pattern 'false' can never match the type 'true' +comparisons.erl:172: The pattern 'true' can never match the type 'false' comparisons.erl:173: The pattern 'true' can never match the type 'false' -comparisons.erl:174: The pattern 'true' can never match the type 'false' +comparisons.erl:174: The pattern 'false' can never match the type 'true' comparisons.erl:175: The pattern 'false' can never match the type 'true' -comparisons.erl:176: The pattern 'false' can never match the type 'true' +comparisons.erl:176: The pattern 'true' can never match the type 'false' +comparisons.erl:177: The pattern 'true' can never match the type 'false' +comparisons.erl:178: The pattern 'false' can never match the type 'true' +comparisons.erl:179: The pattern 'false' can never match the type 'true' +comparisons.erl:180: The pattern 'true' can never match the type 'false' +comparisons.erl:181: The pattern 'true' can never match the type 'false' +comparisons.erl:182: The pattern 'false' can never match the type 'true' +comparisons.erl:183: The pattern 'false' can never match the type 'true' +comparisons.erl:184: The pattern 'true' can never match the type 'false' +comparisons.erl:185: The pattern 'true' can never match the type 'false' comparisons.erl:186: The pattern 'false' can never match the type 'true' comparisons.erl:187: The pattern 'false' can never match the type 'true' -comparisons.erl:188: The pattern 'true' can never match the type 'false' -comparisons.erl:189: The pattern 'true' can never match the type 'false' -comparisons.erl:190: The pattern 'false' can never match the type 'true' -comparisons.erl:191: The pattern 'false' can never match the type 'true' -comparisons.erl:192: The pattern 'true' can never match the type 'false' -comparisons.erl:193: The pattern 'true' can never match the type 'false' -comparisons.erl:203: The pattern 'false' can never match the type 'true' -comparisons.erl:204: The pattern 'false' can never match the type 'true' +comparisons.erl:192: The pattern 'false' can never match the type 'true' +comparisons.erl:193: The pattern 'false' can never match the type 'true' +comparisons.erl:194: The pattern 'true' can never match the type 'false' +comparisons.erl:195: The pattern 'true' can never match the type 'false' +comparisons.erl:196: The pattern 'false' can never match the type 'true' +comparisons.erl:197: The pattern 'false' can never match the type 'true' +comparisons.erl:198: The pattern 'true' can never match the type 'false' +comparisons.erl:199: The pattern 'true' can never match the type 'false' +comparisons.erl:200: The pattern 'false' can never match the type 'true' +comparisons.erl:201: The pattern 'false' can never match the type 'true' +comparisons.erl:202: The pattern 'true' can never match the type 'false' +comparisons.erl:203: The pattern 'true' can never match the type 'false' comparisons.erl:205: The pattern 'true' can never match the type 'false' comparisons.erl:206: The pattern 'true' can never match the type 'false' -comparisons.erl:208: The pattern 'true' can never match the type 'false' +comparisons.erl:207: The pattern 'false' can never match the type 'true' +comparisons.erl:208: The pattern 'false' can never match the type 'true' comparisons.erl:209: The pattern 'true' can never match the type 'false' -comparisons.erl:210: The pattern 'false' can never match the type 'true' +comparisons.erl:210: The pattern 'true' can never match the type 'false' comparisons.erl:211: The pattern 'false' can never match the type 'true' +comparisons.erl:212: The pattern 'false' can never match the type 'true' +comparisons.erl:213: The pattern 'true' can never match the type 'false' +comparisons.erl:214: The pattern 'true' can never match the type 'false' +comparisons.erl:215: The pattern 'false' can never match the type 'true' +comparisons.erl:216: The pattern 'false' can never match the type 'true' +comparisons.erl:217: The pattern 'true' can never match the type 'false' +comparisons.erl:218: The pattern 'true' can never match the type 'false' +comparisons.erl:219: The pattern 'false' can never match the type 'true' +comparisons.erl:220: The pattern 'false' can never match the type 'true' comparisons.erl:221: The pattern 'true' can never match the type 'false' comparisons.erl:222: The pattern 'true' can never match the type 'false' comparisons.erl:223: The pattern 'false' can never match the type 'true' comparisons.erl:224: The pattern 'false' can never match the type 'true' -comparisons.erl:225: The pattern 'true' can never match the type 'false' -comparisons.erl:226: The pattern 'true' can never match the type 'false' -comparisons.erl:227: The pattern 'false' can never match the type 'true' -comparisons.erl:228: The pattern 'false' can never match the type 'true' +comparisons.erl:229: The pattern 'true' can never match the type 'false' +comparisons.erl:230: The pattern 'true' can never match the type 'false' +comparisons.erl:231: The pattern 'false' can never match the type 'true' +comparisons.erl:232: The pattern 'false' can never match the type 'true' +comparisons.erl:233: The pattern 'false' can never match the type 'true' +comparisons.erl:234: The pattern 'false' can never match the type 'true' +comparisons.erl:235: The pattern 'true' can never match the type 'false' +comparisons.erl:236: The pattern 'true' can never match the type 'false' comparisons.erl:242: The pattern 'false' can never match the type 'true' comparisons.erl:243: The pattern 'false' can never match the type 'true' comparisons.erl:244: The pattern 'true' can never match the type 'false' @@ -97,57 +116,86 @@ comparisons.erl:246: The pattern 'false' can never match the type 'true' comparisons.erl:247: The pattern 'false' can never match the type 'true' comparisons.erl:248: The pattern 'true' can never match the type 'false' comparisons.erl:249: The pattern 'true' can never match the type 'false' -comparisons.erl:251: The pattern 'true' can never match the type 'false' -comparisons.erl:252: The pattern 'true' can never match the type 'false' -comparisons.erl:253: The pattern 'false' can never match the type 'true' -comparisons.erl:254: The pattern 'false' can never match the type 'true' -comparisons.erl:263: The pattern 'false' can never match the type 'true' -comparisons.erl:264: The pattern 'false' can never match the type 'true' +comparisons.erl:259: The pattern 'false' can never match the type 'true' +comparisons.erl:260: The pattern 'false' can never match the type 'true' +comparisons.erl:261: The pattern 'true' can never match the type 'false' +comparisons.erl:262: The pattern 'true' can never match the type 'false' +comparisons.erl:264: The pattern 'true' can never match the type 'false' comparisons.erl:265: The pattern 'true' can never match the type 'false' -comparisons.erl:266: The pattern 'true' can never match the type 'false' -comparisons.erl:268: The pattern 'true' can never match the type 'false' -comparisons.erl:269: The pattern 'true' can never match the type 'false' -comparisons.erl:270: The pattern 'false' can never match the type 'true' -comparisons.erl:271: The pattern 'false' can never match the type 'true' -comparisons.erl:272: The pattern 'true' can never match the type 'false' -comparisons.erl:273: The pattern 'true' can never match the type 'false' -comparisons.erl:274: The pattern 'false' can never match the type 'true' -comparisons.erl:275: The pattern 'false' can never match the type 'true' -comparisons.erl:293: The pattern 'false' can never match the type 'true' -comparisons.erl:294: The pattern 'false' can never match the type 'true' -comparisons.erl:295: The pattern 'true' can never match the type 'false' -comparisons.erl:296: The pattern 'true' can never match the type 'false' -comparisons.erl:311: The pattern 'true' can never match the type 'false' -comparisons.erl:312: The pattern 'true' can never match the type 'false' -comparisons.erl:313: The pattern 'false' can never match the type 'true' -comparisons.erl:314: The pattern 'false' can never match the type 'true' -comparisons.erl:44: The pattern 'false' can never match the type 'true' -comparisons.erl:45: The pattern 'false' can never match the type 'true' -comparisons.erl:46: The pattern 'true' can never match the type 'false' -comparisons.erl:47: The pattern 'true' can never match the type 'false' -comparisons.erl:48: The pattern 'false' can never match the type 'true' -comparisons.erl:49: The pattern 'false' can never match the type 'true' -comparisons.erl:50: The pattern 'true' can never match the type 'false' -comparisons.erl:51: The pattern 'true' can never match the type 'false' +comparisons.erl:266: The pattern 'false' can never match the type 'true' +comparisons.erl:267: The pattern 'false' can never match the type 'true' +comparisons.erl:277: The pattern 'true' can never match the type 'false' +comparisons.erl:278: The pattern 'true' can never match the type 'false' +comparisons.erl:279: The pattern 'false' can never match the type 'true' +comparisons.erl:280: The pattern 'false' can never match the type 'true' +comparisons.erl:281: The pattern 'true' can never match the type 'false' +comparisons.erl:282: The pattern 'true' can never match the type 'false' +comparisons.erl:283: The pattern 'false' can never match the type 'true' +comparisons.erl:284: The pattern 'false' can never match the type 'true' +comparisons.erl:298: The pattern 'false' can never match the type 'true' +comparisons.erl:299: The pattern 'false' can never match the type 'true' +comparisons.erl:300: The pattern 'true' can never match the type 'false' +comparisons.erl:301: The pattern 'true' can never match the type 'false' +comparisons.erl:302: The pattern 'false' can never match the type 'true' +comparisons.erl:303: The pattern 'false' can never match the type 'true' +comparisons.erl:304: The pattern 'true' can never match the type 'false' +comparisons.erl:305: The pattern 'true' can never match the type 'false' +comparisons.erl:307: The pattern 'true' can never match the type 'false' +comparisons.erl:308: The pattern 'true' can never match the type 'false' +comparisons.erl:309: The pattern 'false' can never match the type 'true' +comparisons.erl:310: The pattern 'false' can never match the type 'true' +comparisons.erl:319: The pattern 'false' can never match the type 'true' +comparisons.erl:320: The pattern 'false' can never match the type 'true' +comparisons.erl:321: The pattern 'true' can never match the type 'false' +comparisons.erl:322: The pattern 'true' can never match the type 'false' +comparisons.erl:324: The pattern 'true' can never match the type 'false' +comparisons.erl:325: The pattern 'true' can never match the type 'false' +comparisons.erl:326: The pattern 'false' can never match the type 'true' +comparisons.erl:327: The pattern 'false' can never match the type 'true' +comparisons.erl:328: The pattern 'true' can never match the type 'false' +comparisons.erl:329: The pattern 'true' can never match the type 'false' +comparisons.erl:330: The pattern 'false' can never match the type 'true' +comparisons.erl:331: The pattern 'false' can never match the type 'true' +comparisons.erl:349: The pattern 'false' can never match the type 'true' +comparisons.erl:350: The pattern 'false' can never match the type 'true' +comparisons.erl:351: The pattern 'true' can never match the type 'false' +comparisons.erl:352: The pattern 'true' can never match the type 'false' +comparisons.erl:367: The pattern 'true' can never match the type 'false' +comparisons.erl:368: The pattern 'true' can never match the type 'false' +comparisons.erl:369: The pattern 'false' can never match the type 'true' +comparisons.erl:370: The pattern 'false' can never match the type 'true' comparisons.erl:52: The pattern 'false' can never match the type 'true' comparisons.erl:53: The pattern 'false' can never match the type 'true' comparisons.erl:54: The pattern 'true' can never match the type 'false' comparisons.erl:55: The pattern 'true' can never match the type 'false' +comparisons.erl:56: The pattern 'false' can never match the type 'true' +comparisons.erl:57: The pattern 'false' can never match the type 'true' +comparisons.erl:58: The pattern 'true' can never match the type 'false' +comparisons.erl:59: The pattern 'true' can never match the type 'false' +comparisons.erl:60: The pattern 'false' can never match the type 'true' +comparisons.erl:61: The pattern 'false' can never match the type 'true' +comparisons.erl:62: The pattern 'true' can never match the type 'false' +comparisons.erl:63: The pattern 'true' can never match the type 'false' +comparisons.erl:64: The pattern 'false' can never match the type 'true' +comparisons.erl:65: The pattern 'false' can never match the type 'true' +comparisons.erl:66: The pattern 'true' can never match the type 'false' +comparisons.erl:67: The pattern 'true' can never match the type 'false' +comparisons.erl:68: The pattern 'false' can never match the type 'true' comparisons.erl:69: The pattern 'false' can never match the type 'true' -comparisons.erl:70: The pattern 'false' can never match the type 'true' +comparisons.erl:70: The pattern 'true' can never match the type 'false' comparisons.erl:71: The pattern 'true' can never match the type 'false' -comparisons.erl:72: The pattern 'true' can never match the type 'false' -comparisons.erl:73: The pattern 'false' can never match the type 'true' -comparisons.erl:74: The pattern 'false' can never match the type 'true' -comparisons.erl:75: The pattern 'true' can never match the type 'false' -comparisons.erl:76: The pattern 'true' can never match the type 'false' -comparisons.erl:77: The pattern 'false' can never match the type 'true' -comparisons.erl:78: The pattern 'false' can never match the type 'true' -comparisons.erl:79: The pattern 'true' can never match the type 'false' -comparisons.erl:80: The pattern 'true' can never match the type 'false' +comparisons.erl:85: The pattern 'false' can never match the type 'true' +comparisons.erl:86: The pattern 'false' can never match the type 'true' +comparisons.erl:87: The pattern 'true' can never match the type 'false' +comparisons.erl:88: The pattern 'true' can never match the type 'false' +comparisons.erl:89: The pattern 'false' can never match the type 'true' +comparisons.erl:90: The pattern 'false' can never match the type 'true' +comparisons.erl:91: The pattern 'true' can never match the type 'false' +comparisons.erl:92: The pattern 'true' can never match the type 'false' +comparisons.erl:93: The pattern 'false' can never match the type 'true' comparisons.erl:94: The pattern 'false' can never match the type 'true' -comparisons.erl:95: The pattern 'false' can never match the type 'true' +comparisons.erl:95: The pattern 'true' can never match the type 'false' comparisons.erl:96: The pattern 'true' can never match the type 'false' -comparisons.erl:97: The pattern 'true' can never match the type 'false' +comparisons.erl:97: The pattern 'false' can never match the type 'true' comparisons.erl:98: The pattern 'false' can never match the type 'true' -comparisons.erl:99: The pattern 'false' can never match the type 'true' +comparisons.erl:99: The pattern 'true' can never match the type 'false' diff --git a/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes b/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes index a9fbfb6068..d2a3ebb766 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes +++ b/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes @@ -1,15 +1,15 @@ -contracts_with_subtypes.erl:106: The call contracts_with_subtypes:rec_arg({'a','b'}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,{'a',A} | {'b',B}), is_subtype(A,'a' | {'b',B}), is_subtype(B,'b' | {'a',A}) -contracts_with_subtypes.erl:107: The call contracts_with_subtypes:rec_arg({'b','a'}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,{'a',A} | {'b',B}), is_subtype(A,'a' | {'b',B}), is_subtype(B,'b' | {'a',A}) -contracts_with_subtypes.erl:109: The call contracts_with_subtypes:rec_arg({'b',{'a','b'}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,{'a',A} | {'b',B}), is_subtype(A,'a' | {'b',B}), is_subtype(B,'b' | {'a',A}) -contracts_with_subtypes.erl:135: The call contracts_with_subtypes:rec2({'a','b'}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,ab()) -contracts_with_subtypes.erl:136: The call contracts_with_subtypes:rec2({'b','a'}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,ab()) -contracts_with_subtypes.erl:137: The call contracts_with_subtypes:rec2({'a',{'b','a'}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,ab()) -contracts_with_subtypes.erl:138: The call contracts_with_subtypes:rec2({'b',{'a','b'}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,ab()) -contracts_with_subtypes.erl:139: The call contracts_with_subtypes:rec2({'a',{'b',{'a','b'}}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,ab()) -contracts_with_subtypes.erl:140: The call contracts_with_subtypes:rec2({'b',{'a',{'b','a'}}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,ab()) -contracts_with_subtypes.erl:141: The call contracts_with_subtypes:rec2({'a',{'b',{'a',{'b','a'}}}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,ab()) -contracts_with_subtypes.erl:142: The call contracts_with_subtypes:rec2({'b',{'a',{'b',{'a','b'}}}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,ab()) +contracts_with_subtypes.erl:106: The call contracts_with_subtypes:rec_arg({'a','b'}) breaks the contract (Arg) -> 'ok' when Arg :: {'a',A} | {'b',B}, A :: 'a' | {'b',B}, B :: 'b' | {'a',A} +contracts_with_subtypes.erl:107: The call contracts_with_subtypes:rec_arg({'b','a'}) breaks the contract (Arg) -> 'ok' when Arg :: {'a',A} | {'b',B}, A :: 'a' | {'b',B}, B :: 'b' | {'a',A} +contracts_with_subtypes.erl:109: The call contracts_with_subtypes:rec_arg({'b',{'a','b'}}) breaks the contract (Arg) -> 'ok' when Arg :: {'a',A} | {'b',B}, A :: 'a' | {'b',B}, B :: 'b' | {'a',A} +contracts_with_subtypes.erl:135: The call contracts_with_subtypes:rec2({'a','b'}) breaks the contract (Arg) -> 'ok' when Arg :: ab() +contracts_with_subtypes.erl:136: The call contracts_with_subtypes:rec2({'b','a'}) breaks the contract (Arg) -> 'ok' when Arg :: ab() +contracts_with_subtypes.erl:137: The call contracts_with_subtypes:rec2({'a',{'b','a'}}) breaks the contract (Arg) -> 'ok' when Arg :: ab() +contracts_with_subtypes.erl:138: The call contracts_with_subtypes:rec2({'b',{'a','b'}}) breaks the contract (Arg) -> 'ok' when Arg :: ab() +contracts_with_subtypes.erl:139: The call contracts_with_subtypes:rec2({'a',{'b',{'a','b'}}}) breaks the contract (Arg) -> 'ok' when Arg :: ab() +contracts_with_subtypes.erl:140: The call contracts_with_subtypes:rec2({'b',{'a',{'b','a'}}}) breaks the contract (Arg) -> 'ok' when Arg :: ab() +contracts_with_subtypes.erl:141: The call contracts_with_subtypes:rec2({'a',{'b',{'a',{'b','a'}}}}) breaks the contract (Arg) -> 'ok' when Arg :: ab() +contracts_with_subtypes.erl:142: The call contracts_with_subtypes:rec2({'b',{'a',{'b',{'a','b'}}}}) breaks the contract (Arg) -> 'ok' when Arg :: ab() contracts_with_subtypes.erl:175: The pattern 1 can never match the type string() contracts_with_subtypes.erl:178: The pattern 'alpha' can never match the type {'ok',_} | {'ok',_,string()} contracts_with_subtypes.erl:180: The pattern 42 can never match the type {'ok',_} | {'ok',_,string()} @@ -24,13 +24,13 @@ contracts_with_subtypes.erl:23: Invalid type specification for function contract contracts_with_subtypes.erl:240: The pattern {'ok', 42} can never match the type {'ok',_,string()} contracts_with_subtypes.erl:241: The pattern 42 can never match the type {'ok',_,string()} contracts_with_subtypes.erl:267: Function flat_ets_new_t/0 has no local return -contracts_with_subtypes.erl:268: The call contracts_with_subtypes:flat_ets_new(12,[]) breaks the contract (Name,Options) -> atom() when is_subtype(Name,atom()), is_subtype(Options,[Option]), is_subtype(Option,'set' | 'ordered_set' | 'bag' | 'duplicate_bag' | 'public' | 'protected' | 'private' | 'named_table' | {'keypos',integer()} | {'heir',pid(),term()} | {'heir','none'} | {'write_concurrency',boolean()} | {'read_concurrency',boolean()} | 'compressed') +contracts_with_subtypes.erl:268: The call contracts_with_subtypes:flat_ets_new(12,[]) breaks the contract (Name,Options) -> atom() when Name :: atom(), Options :: [Option], Option :: 'set' | 'ordered_set' | 'bag' | 'duplicate_bag' | 'public' | 'protected' | 'private' | 'named_table' | {'keypos',integer()} | {'heir',pid(),term()} | {'heir','none'} | {'write_concurrency',boolean()} | {'read_concurrency',boolean()} | 'compressed' contracts_with_subtypes.erl:294: Function factored_ets_new_t/0 has no local return -contracts_with_subtypes.erl:295: The call contracts_with_subtypes:factored_ets_new(12,[]) breaks the contract (Name,Options) -> atom() when is_subtype(Name,atom()), is_subtype(Options,[Option]), is_subtype(Option,Type | Access | 'named_table' | {'keypos',Pos} | {'heir',Pid::pid(),HeirData} | {'heir','none'} | Tweaks), is_subtype(Type,type()), is_subtype(Access,access()), is_subtype(Tweaks,{'write_concurrency',boolean()} | {'read_concurrency',boolean()} | 'compressed'), is_subtype(Pos,pos_integer()), is_subtype(HeirData,term()) -contracts_with_subtypes.erl:77: The call contracts_with_subtypes:foo1(5) breaks the contract (Arg1) -> Res when is_subtype(Arg1,atom()), is_subtype(Res,atom()) -contracts_with_subtypes.erl:78: The call contracts_with_subtypes:foo2(5) breaks the contract (Arg1) -> Res when is_subtype(Arg1,Arg2), is_subtype(Arg2,atom()), is_subtype(Res,atom()) -contracts_with_subtypes.erl:79: The call contracts_with_subtypes:foo3(5) breaks the contract (Arg1) -> Res when is_subtype(Arg2,atom()), is_subtype(Arg1,Arg2), is_subtype(Res,atom()) +contracts_with_subtypes.erl:295: The call contracts_with_subtypes:factored_ets_new(12,[]) breaks the contract (Name,Options) -> atom() when Name :: atom(), Options :: [Option], Option :: Type | Access | 'named_table' | {'keypos',Pos} | {'heir',Pid::pid(),HeirData} | {'heir','none'} | Tweaks, Type :: type(), Access :: access(), Tweaks :: {'write_concurrency',boolean()} | {'read_concurrency',boolean()} | 'compressed', Pos :: pos_integer(), HeirData :: term() +contracts_with_subtypes.erl:77: The call contracts_with_subtypes:foo1(5) breaks the contract (Arg1) -> Res when Arg1 :: atom(), Res :: atom() +contracts_with_subtypes.erl:78: The call contracts_with_subtypes:foo2(5) breaks the contract (Arg1) -> Res when Arg1 :: Arg2, Arg2 :: atom(), Res :: atom() +contracts_with_subtypes.erl:79: The call contracts_with_subtypes:foo3(5) breaks the contract (Arg1) -> Res when Arg2 :: atom(), Arg1 :: Arg2, Res :: atom() contracts_with_subtypes.erl:7: Invalid type specification for function contracts_with_subtypes:extract/0. The success typing is () -> 'something' -contracts_with_subtypes.erl:80: The call contracts_with_subtypes:foo4(5) breaks the contract (Type) -> Type when is_subtype(Type,atom()) +contracts_with_subtypes.erl:80: The call contracts_with_subtypes:foo4(5) breaks the contract (Type) -> Type when Type :: atom() contracts_with_subtypes.erl:81: The call contracts_with_subtypes:foo5(5) breaks the contract (Type::atom()) -> Type::atom() -contracts_with_subtypes.erl:82: The call contracts_with_subtypes:foo6(5) breaks the contract (Type) -> Type when is_subtype(Type,atom()) +contracts_with_subtypes.erl:82: The call contracts_with_subtypes:foo6(5) breaks the contract (Type) -> Type when Type :: atom() diff --git a/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes2 b/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes2 index 9f5433a13d..1a8aeb13d0 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes2 +++ b/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes2 @@ -1,3 +1,3 @@ contracts_with_subtypes2.erl:18: Function t/0 has no local return -contracts_with_subtypes2.erl:19: The call contracts_with_subtypes2:t({'a',{'b',{'c',{'d',{'e',{'g',3}}}}}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,{'a',A}), is_subtype(A,{'b',B}), is_subtype(B,{'c',C}), is_subtype(C,{'d',D}), is_subtype(D,{'e',E}), is_subtype(E,{'f',_}) +contracts_with_subtypes2.erl:19: The call contracts_with_subtypes2:t({'a',{'b',{'c',{'d',{'e',{'g',3}}}}}}) breaks the contract (Arg) -> 'ok' when Arg :: {'a',A}, A :: {'b',B}, B :: {'c',C}, C :: {'d',D}, D :: {'e',E}, E :: {'f',_} diff --git a/lib/dialyzer/test/small_SUITE_data/results/fun_arity b/lib/dialyzer/test/small_SUITE_data/results/fun_arity index 280f5490d0..cc9db65152 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/fun_arity +++ b/lib/dialyzer/test/small_SUITE_data/results/fun_arity @@ -31,5 +31,7 @@ fun_arity.erl:81: Function mfa_ne_1_ko/0 has no local return fun_arity.erl:83: Function mf_ne/1 will never be called fun_arity.erl:89: Fun application will fail since _cor0 :: fun(() -> any()) is not a function of arity 1 fun_arity.erl:89: Function mfa_nd_0_ko/0 has no local return +fun_arity.erl:90: Call to missing or unexported function fun_arity:mf_nd/0 fun_arity.erl:93: Fun application will fail since _cor0 :: fun((_) -> any()) is not a function of arity 0 fun_arity.erl:93: Function mfa_nd_1_ko/0 has no local return +fun_arity.erl:94: Call to missing or unexported function fun_arity:mf_nd/1 diff --git a/lib/dialyzer/test/small_SUITE_data/results/literals b/lib/dialyzer/test/small_SUITE_data/results/literals index 03e161ca71..222d2c0cdb 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/literals +++ b/lib/dialyzer/test/small_SUITE_data/results/literals @@ -1,14 +1,14 @@ literals.erl:11: Function t1/0 has no local return -literals.erl:12: Record construction #r{id::'a'} violates the declared type of field id::'integer' | 'undefined' +literals.erl:12: Record construction #r{id::'a'} violates the declared type of field id::'integer' literals.erl:14: Function t2/0 has no local return -literals.erl:15: Record construction #r{id::'a'} violates the declared type of field id::'integer' | 'undefined' +literals.erl:15: Record construction #r{id::'a'} violates the declared type of field id::'integer' literals.erl:17: Function t3/0 has no local return -literals.erl:18: Record construction #r{id::'a'} violates the declared type of field id::'integer' | 'undefined' -literals.erl:21: Record construction #r{id::'a'} violates the declared type of field id::'integer' | 'undefined' +literals.erl:18: Record construction #r{id::'a'} violates the declared type of field id::'integer' +literals.erl:21: Record construction #r{id::'a'} violates the declared type of field id::'integer' literals.erl:23: Function m1/1 has no local return -literals.erl:23: Matching of pattern {'r', 'a'} tagged with a record name violates the declared type of #r{id::'integer' | 'undefined'} +literals.erl:23: Matching of pattern {'r', 'a'} tagged with a record name violates the declared type of #r{id::'integer'} literals.erl:26: Function m2/1 has no local return -literals.erl:26: Matching of pattern {'r', 'a'} tagged with a record name violates the declared type of #r{id::'integer' | 'undefined'} +literals.erl:26: Matching of pattern {'r', 'a'} tagged with a record name violates the declared type of #r{id::'integer'} literals.erl:29: Function m3/1 has no local return literals.erl:29: The pattern {{'r', 'a'}} can never match the type any() diff --git a/lib/dialyzer/test/small_SUITE_data/results/maps1 b/lib/dialyzer/test/small_SUITE_data/results/maps1 new file mode 100644 index 0000000000..e88c91f21f --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/maps1 @@ -0,0 +1,4 @@ + +maps1.erl:43: Function t3/0 has no local return +maps1.erl:44: The call maps1:foo(~{'greger'=>3, ~{'arne'=>'anka'}~=>45}~,1) will never return since it differs in the 2nd argument from the success typing arguments: (#{},'b') +maps1.erl:52: The call Mod:'function'(~{'literal'=>'map'}~,'another_arg') requires that Mod is of type atom() not #{} diff --git a/lib/dialyzer/test/small_SUITE_data/results/non_existing b/lib/dialyzer/test/small_SUITE_data/results/non_existing index 58da2bfc8b..b0da5998c7 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/non_existing +++ b/lib/dialyzer/test/small_SUITE_data/results/non_existing @@ -1,2 +1,3 @@ +non_existing.erl:12: Call to missing or unexported function lists:non_existing_fun/1 non_existing.erl:9: Call to missing or unexported function lists:non_existing_call/1 diff --git a/lib/dialyzer/test/small_SUITE_data/results/pretty_bitstring b/lib/dialyzer/test/small_SUITE_data/results/pretty_bitstring index 0ad6eee766..e148e5cf22 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/pretty_bitstring +++ b/lib/dialyzer/test/small_SUITE_data/results/pretty_bitstring @@ -1,3 +1,3 @@ pretty_bitstring.erl:7: Function t/0 has no local return -pretty_bitstring.erl:8: The call binary:copy(#{#<1>(8, 1, 'integer', ['unsigned', 'big']), #<2>(8, 1, 'integer', ['unsigned', 'big']), #<3>(3, 1, 'integer', ['unsigned', 'big'])}#,2) breaks the contract (Subject,N) -> binary() when is_subtype(Subject,binary()), is_subtype(N,non_neg_integer()) +pretty_bitstring.erl:8: The call binary:copy(#{#<1>(8, 1, 'integer', ['unsigned', 'big']), #<2>(8, 1, 'integer', ['unsigned', 'big']), #<3>(3, 1, 'integer', ['unsigned', 'big'])}#,2) breaks the contract (Subject,N) -> binary() when Subject :: binary(), N :: non_neg_integer() diff --git a/lib/dialyzer/test/small_SUITE_data/results/record_creation_diffs b/lib/dialyzer/test/small_SUITE_data/results/record_creation_diffs index f00c4b10ff..c971935bbf 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/record_creation_diffs +++ b/lib/dialyzer/test/small_SUITE_data/results/record_creation_diffs @@ -1,3 +1,3 @@ record_creation_diffs.erl:10: Function foo/1 has no local return -record_creation_diffs.erl:11: Record construction #bar{some_list::{'this','is','a','tuple'}} violates the declared type of field some_list::'undefined' | [any()] +record_creation_diffs.erl:11: Record construction #bar{some_list::{'this','is','a','tuple'}} violates the declared type of field some_list::[any()] diff --git a/lib/dialyzer/test/small_SUITE_data/results/record_pat b/lib/dialyzer/test/small_SUITE_data/results/record_pat index a46be6c451..8317ea041a 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/record_pat +++ b/lib/dialyzer/test/small_SUITE_data/results/record_pat @@ -1,2 +1,2 @@ -record_pat.erl:14: Matching of pattern {'foo', 'baz'} tagged with a record name violates the declared type of #foo{bar::'undefined' | integer()} +record_pat.erl:14: Matching of pattern {'foo', 'baz'} tagged with a record name violates the declared type of #foo{bar::integer()} diff --git a/lib/dialyzer/test/small_SUITE_data/results/relevant_record_warning b/lib/dialyzer/test/small_SUITE_data/results/relevant_record_warning index 2e417e1b2a..ea3ac92d96 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/relevant_record_warning +++ b/lib/dialyzer/test/small_SUITE_data/results/relevant_record_warning @@ -1,3 +1,3 @@ relevant_record_warning.erl:22: Function test/1 has no local return -relevant_record_warning.erl:23: Record construction #r{field::<<_:8>>} violates the declared type of field field::'binary' | 'undefined' +relevant_record_warning.erl:23: Record construction #r{field::<<_:8>>} violates the declared type of field field::'binary' diff --git a/lib/dialyzer/test/small_SUITE_data/results/undefined b/lib/dialyzer/test/small_SUITE_data/results/undefined new file mode 100644 index 0000000000..9daa8640d3 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/undefined @@ -0,0 +1,2 @@ + +r.erl:16: Record construction #r{a::{'fi'},b::{'a','b'},c::[],d::'undefined',e::[],f::'undefined'} violates the declared type of field b::[any()] and d::[any()] and f::[any()] diff --git a/lib/dialyzer/test/small_SUITE_data/src/bif1/bif1.erl b/lib/dialyzer/test/small_SUITE_data/src/bif1/bif1.erl new file mode 100644 index 0000000000..bc746538d3 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/bif1/bif1.erl @@ -0,0 +1,16 @@ +-module(bif1). + +%% Other set of warnings due to removed of functions from +%% erl_bif_types. + +-export([ets_rename/0, string_chars/0]). + +ets_rename() -> + A = ets:new(fipp, []), + true = not is_atom(A), + ets:rename(A, fopp). % No warning + +string_chars() -> + L2 = bif1_adt:opaque_string(), + S = $A, + string:chars(S, 10, L2). % Warning diff --git a/lib/dialyzer/test/small_SUITE_data/src/bif1/bif1_adt.erl b/lib/dialyzer/test/small_SUITE_data/src/bif1/bif1_adt.erl new file mode 100644 index 0000000000..01b0bccc68 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/bif1/bif1_adt.erl @@ -0,0 +1,12 @@ +-module(bif1_adt). + +-export([opaque_string/0]). + +-export_type([s/0]). + +-opaque s() :: string(). + +-spec opaque_string() -> s(). + +opaque_string() -> + "string". diff --git a/lib/dialyzer/test/small_SUITE_data/src/big_external_type.erl b/lib/dialyzer/test/small_SUITE_data/src/big_external_type.erl index ab84e94106..9ad4810a5e 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/big_external_type.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/big_external_type.erl @@ -36,7 +36,7 @@ %% Start of Abstract Format --type line() :: erl_scan:line(). +-type line() :: erl_anno:line(). -export_type([af_record_index/0, af_record_field/1, af_record_name/0, af_field_name/0, af_function_decl/0]). @@ -332,8 +332,8 @@ %% End of Abstract Format -type error_description() :: term(). --type error_info() :: {erl_scan:line(), module(), error_description()}. --type token() :: {Tag :: atom(), Line :: erl_scan:line()}. +-type error_info() :: {erl_anno:line(), module(), error_description()}. +-type token() :: {Tag :: atom(), Line :: erl_scan:anno()}. %% mkop(Op, Arg) -> {op,Line,Op,Arg}. %% mkop(Left, Op, Right) -> {op,Line,Op,Left,Right}. diff --git a/lib/dialyzer/test/small_SUITE_data/src/big_local_type.erl b/lib/dialyzer/test/small_SUITE_data/src/big_local_type.erl index fc7c5241a8..fe567ff10d 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/big_local_type.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/big_local_type.erl @@ -36,7 +36,7 @@ %% Start of Abstract Format --type line() :: erl_scan:line(). +-type line() :: erl_anno:line(). -export_type([af_module/0, af_export/0, af_import/0, af_fa_list/0, af_compile/0, af_file/0, af_record_decl/0, @@ -329,8 +329,8 @@ %% End of Abstract Format -type error_description() :: term(). --type error_info() :: {erl_scan:line(), module(), error_description()}. --type token() :: {Tag :: atom(), Line :: erl_scan:line()}. +-type error_info() :: {erl_anno:line(), module(), error_description()}. +-type token() :: {Tag :: atom(), Line :: erl_anno:line()}. %% mkop(Op, Arg) -> {op,Line,Op,Arg}. %% mkop(Left, Op, Right) -> {op,Line,Op,Left,Right}. diff --git a/lib/dialyzer/test/small_SUITE_data/src/comparisons.erl b/lib/dialyzer/test/small_SUITE_data/src/comparisons.erl index 70e3cb6af4..64927c6c91 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/comparisons.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/comparisons.erl @@ -19,12 +19,20 @@ tuple(X) when is_tuple(X) -> X. list() -> list(?r). list(X) when is_list(X) -> X. +map() -> map(?r). +map(X) when is_map(X) -> #{}. + +bitstring() -> bitstring(?r). +bitstring(X) when is_bitstring(X) -> <<0:63>>. + i() -> integer(). f() -> mfloat(). n() -> case ?r of 1 -> i(); 2 -> f() end. a() -> atom(). t() -> tuple(). l() -> list(). +m() -> map(). +b() -> bitstring(). na() -> case ?r of 1 -> n(); 2 -> a() end. at() -> case ?r of 1 -> t(); 2 -> a() end. tl() -> case ?r of 1 -> t(); 2 -> l() end. @@ -53,6 +61,14 @@ test_i_ll_l() -> case i() < l() of true -> always; false -> never end. test_i_le_l() -> case i() =< l() of true -> always; false -> never end. test_i_gg_l() -> case i() > l() of true -> never; false -> always end. test_i_ge_l() -> case i() >= l() of true -> never; false -> always end. +test_i_ll_m() -> case i() < m() of true -> always; false -> never end. +test_i_le_m() -> case i() =< m() of true -> always; false -> never end. +test_i_gg_m() -> case i() > m() of true -> never; false -> always end. +test_i_ge_m() -> case i() >= m() of true -> never; false -> always end. +test_i_ll_b() -> case i() < b() of true -> always; false -> never end. +test_i_le_b() -> case i() =< b() of true -> always; false -> never end. +test_i_gg_b() -> case i() > b() of true -> never; false -> always end. +test_i_ge_b() -> case i() >= b() of true -> never; false -> always end. test_f_ll_i() -> case f() < i() of true -> maybe; false -> maybe_too end. test_f_le_i() -> case f() =< i() of true -> maybe; false -> maybe_too end. @@ -78,6 +94,14 @@ test_f_ll_l() -> case f() < l() of true -> always; false -> never end. test_f_le_l() -> case f() =< l() of true -> always; false -> never end. test_f_gg_l() -> case f() > l() of true -> never; false -> always end. test_f_ge_l() -> case f() >= l() of true -> never; false -> always end. +test_f_ll_m() -> case f() < m() of true -> always; false -> never end. +test_f_le_m() -> case f() =< m() of true -> always; false -> never end. +test_f_gg_m() -> case f() > m() of true -> never; false -> always end. +test_f_ge_m() -> case f() >= m() of true -> never; false -> always end. +test_f_ll_b() -> case f() < b() of true -> always; false -> never end. +test_f_le_b() -> case f() =< b() of true -> always; false -> never end. +test_f_gg_b() -> case f() > b() of true -> never; false -> always end. +test_f_ge_b() -> case f() >= b() of true -> never; false -> always end. test_n_ll_i() -> case n() < i() of true -> maybe; false -> maybe_too end. test_n_le_i() -> case n() =< i() of true -> maybe; false -> maybe_too end. @@ -103,6 +127,14 @@ test_n_ll_l() -> case n() < l() of true -> always; false -> never end. test_n_le_l() -> case n() =< l() of true -> always; false -> never end. test_n_gg_l() -> case n() > l() of true -> never; false -> always end. test_n_ge_l() -> case n() >= l() of true -> never; false -> always end. +test_n_ll_m() -> case n() < m() of true -> always; false -> never end. +test_n_le_m() -> case n() =< m() of true -> always; false -> never end. +test_n_gg_m() -> case n() > m() of true -> never; false -> always end. +test_n_ge_m() -> case n() >= m() of true -> never; false -> always end. +test_n_ll_b() -> case n() < b() of true -> always; false -> never end. +test_n_le_b() -> case n() =< b() of true -> always; false -> never end. +test_n_gg_b() -> case n() > b() of true -> never; false -> always end. +test_n_ge_b() -> case n() >= b() of true -> never; false -> always end. test_a_ll_i() -> case a() < i() of true -> never; false -> always end. test_a_le_i() -> case a() =< i() of true -> never; false -> always end. @@ -128,6 +160,14 @@ test_a_ll_l() -> case a() < l() of true -> always; false -> never end. test_a_le_l() -> case a() =< l() of true -> always; false -> never end. test_a_gg_l() -> case a() > l() of true -> never; false -> always end. test_a_ge_l() -> case a() >= l() of true -> never; false -> always end. +test_a_ll_m() -> case a() < m() of true -> always; false -> never end. +test_a_le_m() -> case a() =< m() of true -> always; false -> never end. +test_a_gg_m() -> case a() > m() of true -> never; false -> always end. +test_a_ge_m() -> case a() >= m() of true -> never; false -> always end. +test_a_ll_b() -> case a() < b() of true -> always; false -> never end. +test_a_le_b() -> case a() =< b() of true -> always; false -> never end. +test_a_gg_b() -> case a() > b() of true -> never; false -> always end. +test_a_ge_b() -> case a() >= b() of true -> never; false -> always end. test_t_ll_i() -> case t() < i() of true -> never; false -> always end. test_t_le_i() -> case t() =< i() of true -> never; false -> always end. @@ -153,6 +193,14 @@ test_t_ll_l() -> case t() < l() of true -> always; false -> never end. test_t_le_l() -> case t() =< l() of true -> always; false -> never end. test_t_gg_l() -> case t() > l() of true -> never; false -> always end. test_t_ge_l() -> case t() >= l() of true -> never; false -> always end. +test_t_ll_m() -> case t() < m() of true -> always; false -> never end. +test_t_le_m() -> case t() =< m() of true -> always; false -> never end. +test_t_gg_m() -> case t() > m() of true -> never; false -> always end. +test_t_ge_m() -> case t() >= m() of true -> never; false -> always end. +test_t_ll_b() -> case t() < b() of true -> always; false -> never end. +test_t_le_b() -> case t() =< b() of true -> always; false -> never end. +test_t_gg_b() -> case t() > b() of true -> never; false -> always end. +test_t_ge_b() -> case t() >= b() of true -> never; false -> always end. test_l_ll_i() -> case l() < i() of true -> never; false -> always end. test_l_le_i() -> case l() =< i() of true -> never; false -> always end. @@ -178,6 +226,14 @@ test_l_ll_l() -> case l() < l() of true -> maybe; false -> maybe_too end. test_l_le_l() -> case l() =< l() of true -> maybe; false -> maybe_too end. test_l_gg_l() -> case l() > l() of true -> maybe; false -> maybe_too end. test_l_ge_l() -> case l() >= l() of true -> maybe; false -> maybe_too end. +test_l_ll_m() -> case l() < m() of true -> never; false -> always end. +test_l_le_m() -> case l() =< m() of true -> never; false -> always end. +test_l_gg_m() -> case l() > m() of true -> always; false -> never end. +test_l_ge_m() -> case l() >= m() of true -> always; false -> never end. +test_l_ll_b() -> case l() < b() of true -> always; false -> never end. +test_l_le_b() -> case l() =< b() of true -> always; false -> never end. +test_l_gg_b() -> case l() > b() of true -> never; false -> always end. +test_l_ge_b() -> case l() >= b() of true -> never; false -> always end. test_n_ll_na() -> case n() < na() of true -> maybe; false -> maybe_too end. test_n_le_na() -> case n() =< na() of true -> maybe; false -> maybe_too end. diff --git a/lib/dialyzer/test/small_SUITE_data/src/maps1.erl b/lib/dialyzer/test/small_SUITE_data/src/maps1.erl index 06ced5b69e..bb2f66a498 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/maps1.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/maps1.erl @@ -39,3 +39,15 @@ t2() -> ok. update(#{ id := Id, val := Val } = M, X) when is_integer(Id) -> M#{ val := [Val,X] }. + +t3() -> + foo(#{greger => 3, #{arne=>anka} => 45}, 1). + +foo(#{} = M, b) -> %% Error + M#{alfa => 42, beta := 1337}. + +t4() -> + case #{} of + #{} -> ok; + Mod -> Mod:function(#{literal => map}, another_arg) %% Error + end. diff --git a/lib/dialyzer/test/small_SUITE_data/src/trec.erl b/lib/dialyzer/test/small_SUITE_data/src/trec.erl index 06706162c1..516358f7c6 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/trec.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/trec.erl @@ -8,7 +8,7 @@ -module(trec). -export([test/0, mk_foo_exp/2]). --record(foo, {a :: integer(), b :: [atom()]}). +-record(foo, {a :: integer() | 'undefined', b :: [atom()]}). %% %% For these functions we currently get the following warnings: diff --git a/lib/dialyzer/test/small_SUITE_data/undefined.erl b/lib/dialyzer/test/small_SUITE_data/undefined.erl new file mode 100644 index 0000000000..8549f2e161 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/undefined.erl @@ -0,0 +1,29 @@ +-module(undefined). + +-export([t/0]). + +%% As of OTP 19.0 'undefined' is no longer added to fields with a type +%% declaration but without an initializer. The pretty printing of +%% records (erl_types:t_to_string()) is updated to reflect this: if a +%% field is of type 'undefined', it is output if 'undefined' is not in +%% the declared type of the field. (It used to be the case that the +%% singleton type 'undefined' was never output.) +%% +%% One consequence is shown by the example below: the warning about +%% the record construction violating the the declared type shows +%% #r{..., d::'undefined', ...} which is meant to be of help to the +%% user, who could otherwise get confused the first time (s)he gets +%% confronted by the warning. + +-record(r, + { + a = {fi}, + b = {a,b} :: list(), % violation + c = {a,b} :: list(), + d :: list(), % violation + e = [] :: list(), + f = undefined :: list() % violation + }). + +t() -> + #r{c = []}. diff --git a/lib/dialyzer/test/user_SUITE_data/results/wsp_pdu b/lib/dialyzer/test/user_SUITE_data/results/wsp_pdu index d1f8f4caf2..626e677524 100644 --- a/lib/dialyzer/test/user_SUITE_data/results/wsp_pdu +++ b/lib/dialyzer/test/user_SUITE_data/results/wsp_pdu @@ -6,7 +6,7 @@ wsp_pdu.erl:2403: The call wsp_pdu:d_date(Data1::binary()) will never return sin wsp_pdu.erl:2406: Guard test is_integer(Sec::{[byte()] | byte() | {'long',binary()} | {'short',binary()},binary()}) can never succeed wsp_pdu.erl:2408: The pattern {'short', Data2} can never match the type {[byte()] | byte() | {'long',binary()} | {'short',binary()},binary()} wsp_pdu.erl:2755: Function parse_push_flag/1 has no local return -wsp_pdu.erl:2756: The call erlang:integer_to_list(Value::[any()]) breaks the contract (Integer) -> string() when is_subtype(Integer,integer()) +wsp_pdu.erl:2756: The call erlang:integer_to_list(Value::[any()]) breaks the contract (Integer) -> string() when Integer :: integer() wsp_pdu.erl:2875: The call wsp_pdu:d_text_string(Data::byte()) will never return since it differs in the 1st argument from the success typing arguments: (binary()) wsp_pdu.erl:2976: The call wsp_pdu:d_q_value(QData::byte()) will never return since it differs in the 1st argument from the success typing arguments: (<<_:8,_:_*8>>) wsp_pdu.erl:3336: The call wsp_pdu:encode_typed_field(Ver::any(),'Q-value',ParamValue::any()) will never return since it differs in the 2nd argument from the success typing arguments: (any(),'Constrained-encoding' | 'Date-value' | 'No-value' | 'Short-integer' | 'Text-string' | 'Text-value' | 'Well-known-charset',any()) diff --git a/lib/diameter/doc/src/diameter.xml b/lib/diameter/doc/src/diameter.xml index 61b7fd1337..5cb29c80e3 100644 --- a/lib/diameter/doc/src/diameter.xml +++ b/lib/diameter/doc/src/diameter.xml @@ -467,7 +467,7 @@ Matches only those peers whose Origin-Host has the specified value, or all peers if the atom <c>any</c>.</p> </item> -<tag><c>{realm, any|&dict_DiameterIdentity;</c></tag> +<tag><c>{realm, any|&dict_DiameterIdentity;}</c></tag> <item> <p> Matches only those peers whose Origin-Realm has the @@ -500,18 +500,22 @@ Matches only those peers matched by each filter in the specified list.</p> <item> <p> Matches only those peers matched by at least one filter in the -specified list.</p> +specified list. +The resulting list will be in match order, peers matching the +first filter of the list sorting before those matched by the second, +and so on.</p> +</item> +<tag><c>{first, [&peer_filter;]}</c></tag> +<item> <p> -The resulting peer list will be in match order, peers matching the -first filter of the list sorting before those matched by the second, -and so on. -For example, the following filter causes peers matching both the host -and realm filters to be presented before those matching only the realm -filter.</p> +Like <c>any</c>, but stops at the first filter for which there are +matches, which can be much more efficient when there are many peers. +For example, the following filter causes only peers best matching +both the host and realm filters to be presented.</p> <pre> -{any, [{all, [host, realm]}, realm]} +{first, [{all, [host, realm]}, realm]} </pre> </item> diff --git a/lib/diameter/src/base/diameter_peer_fsm.erl b/lib/diameter/src/base/diameter_peer_fsm.erl index 2b23183d18..fb874013a3 100644 --- a/lib/diameter/src/base/diameter_peer_fsm.erl +++ b/lib/diameter/src/base/diameter_peer_fsm.erl @@ -117,7 +117,7 @@ parent :: pid(), %% watchdog process transport :: pid(), %% transport process dictionary :: module(), %% common dictionary - service :: #diameter_service{}, + service :: #diameter_service{} | undefined, dpr = false :: false | true %% DPR received, DPA sent | {boolean(), uint32(), uint32()}, diff --git a/lib/diameter/src/base/diameter_service.erl b/lib/diameter/src/base/diameter_service.erl index 13508321c3..58b1cd742b 100644 --- a/lib/diameter/src/base/diameter_service.erl +++ b/lib/diameter/src/base/diameter_service.erl @@ -137,7 +137,7 @@ %% Record representing an RFC 3539 watchdog process implemented by %% diameter_watchdog. -record(watchdog, - {pid :: match(pid()), + {pid :: match(pid()) | undefined, type :: match(connect | accept), ref :: match(reference()), %% key into diameter_config options :: match([diameter:transport_opt()]),%% from start_transport @@ -208,7 +208,7 @@ stop_transport(SvcName, [_|_] = Refs) -> info(SvcName, Item) -> case lookup_state(SvcName) of - [#state{} = S] -> + [S] -> service_info(Item, S); [] -> undefined @@ -217,7 +217,12 @@ info(SvcName, Item) -> %% lookup_state/1 lookup_state(SvcName) -> - ets:lookup(?STATE_TABLE, SvcName). + case ets:lookup(?STATE_TABLE, SvcName) of + [#state{}] = L -> + L; + _ -> + [] + end. %% --------------------------------------------------------------------------- %% # subscribe/1 diff --git a/lib/diameter/src/diameter.appup.src b/lib/diameter/src/diameter.appup.src index ddde648e08..ba0e79907c 100644 --- a/lib/diameter/src/diameter.appup.src +++ b/lib/diameter/src/diameter.appup.src @@ -44,6 +44,8 @@ {"1.9.1", [{restart_application, diameter}]}, %% 17.5.3 {"1.9.2", [{restart_application, diameter}]}, %% 17.5.5 {"1.9.2.1", [{restart_application, diameter}]}, %% 17.5.6.3 + {"1.9.2.2", [{restart_application, diameter}]}, %% 17.5.6.7 + {"1.9.2.3", [{restart_application, diameter}]}, %% 17.5.6.8 {"1.10", [{load_module, diameter_codec}, %% 18.0 {load_module, diameter_peer_fsm}, {load_module, diameter_watchdog}, @@ -87,6 +89,8 @@ {"1.9.1", [{restart_application, diameter}]}, {"1.9.2", [{restart_application, diameter}]}, {"1.9.2.1", [{restart_application, diameter}]}, + {"1.9.2.2", [{restart_application, diameter}]}, + {"1.9.2.3", [{restart_application, diameter}]}, {"1.10", [{load_module, diameter_gen_relay}, {load_module, diameter_gen_base_accounting}, {load_module, diameter_gen_base_rfc3588}, diff --git a/lib/diameter/src/transport/diameter_sctp.erl b/lib/diameter/src/transport/diameter_sctp.erl index 678dc9b5d6..8a80ce630a 100644 --- a/lib/diameter/src/transport/diameter_sctp.erl +++ b/lib/diameter/src/transport/diameter_sctp.erl @@ -84,16 +84,18 @@ %% Accepting/connecting transport process state. -record(transport, - {parent :: pid(), + {parent :: pid() | undefined, mode :: {accept, pid()} | accept | {connect, {[inet:ip_address()], uint(), list()}} %% {RAs, RP, Errors} | connect, - socket :: gen_sctp:sctp_socket(), + socket :: gen_sctp:sctp_socket() | undefined, assoc_id :: gen_sctp:assoc_id(), %% association identifier - peer :: {[inet:ip_address()], uint()}, %% {RAs, RP} - streams :: {uint(), uint()}, %% {InStream, OutStream} counts + peer :: {[inet:ip_address()], uint()} %% {RAs, RP} + | undefined, + streams :: {uint(), uint()} %% {InStream, OutStream} counts + | undefined, os = 0 :: uint()}). %% next output stream %% Listener process state. @@ -102,7 +104,7 @@ socket :: gen_sctp:sctp_socket(), count = 0 :: uint(), %% attached transport processes pending = {0, queue:new()}, - tref :: reference(), + tref :: reference() | undefined, accept :: [match()]}). %% Field pending implements two queues: the first of transport-to-be %% processes to which an association has been assigned but for which diff --git a/lib/diameter/src/transport/diameter_tcp.erl b/lib/diameter/src/transport/diameter_tcp.erl index 005b2442c0..c79d85820b 100644 --- a/lib/diameter/src/transport/diameter_tcp.erl +++ b/lib/diameter/src/transport/diameter_tcp.erl @@ -73,7 +73,7 @@ %% Listener process state. -record(listener, {socket :: inet:socket(), count = 1 :: non_neg_integer(), - tref :: reference()}). + tref :: reference() | undefined}). %% Monitor process state. -record(monitor, diff --git a/lib/diameter/test/diameter_traffic_SUITE.erl b/lib/diameter/test/diameter_traffic_SUITE.erl index 7e316c03f1..967a0bf591 100644 --- a/lib/diameter/test/diameter_traffic_SUITE.erl +++ b/lib/diameter/test/diameter_traffic_SUITE.erl @@ -725,7 +725,8 @@ send_any_2(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}, {'Destination-Host', [?HOST(SN, "unknown.org")]}], ?answer_message(?UNABLE_TO_DELIVER) - = call(Config, Req, [{filter, {any, [host, realm]}}]). + = call(Config, Req, [{filter, {first, [{all, [host, realm]}, + realm]}}]). %% Send with a conjunctive filter. send_all_1(Config) -> diff --git a/lib/edoc/doc/overview.edoc b/lib/edoc/doc/overview.edoc index 3639bb43a5..d2bba9d744 100644 --- a/lib/edoc/doc/overview.edoc +++ b/lib/edoc/doc/overview.edoc @@ -755,7 +755,7 @@ following escape sequences may be used: <dl> === Function specifications === -<note>Although the syntax described in the following can still be used +Note that although the syntax described in the following can still be used for specifying functions we recommend that Erlang specifications as described in <seealso marker="doc/reference_manual:typespec"> Types and Function Specification</seealso> should be added to the source @@ -764,7 +764,6 @@ marker="dialyzer:dialyzer">Dialyzer</seealso>'s can be utilized in the process of keeping the documentation consistent and up-to-date. Erlang specifications will be used unless there is also a function specification (a `@spec' tag followed by a type) with the same name. -</note> The following grammar describes the form of the specifications following a `@spec' tag. A '`?'' suffix implies that the element is optional. @@ -973,12 +972,12 @@ contain any annotations at all. === Type definitions === -<note>Although the syntax described in the following can still be used +Note that although the syntax described in the following can still be used for specifying types we recommend that Erlang types as described in <seealso marker="doc/reference_manual:typespec"> Types and Function Specification</seealso> should be added to the source code instead. Erlang types will be used unless there is a type alias with the same -name.</note> +name. The following grammar (see above for auxiliary definitions) describes the form of the definitions that may follow a `@type' tag: diff --git a/lib/edoc/src/edoc.erl b/lib/edoc/src/edoc.erl index 90f1fc3071..d2494b69fe 100644 --- a/lib/edoc/src/edoc.erl +++ b/lib/edoc/src/edoc.erl @@ -555,7 +555,6 @@ read_source(Name) -> %% <dd>Specifies a list of pre-defined Erlang preprocessor (`epp') %% macro definitions, used if the `preprocess' option is turned on. %% The default value is the empty list.</dd> -%% </dl> %% <dt>{@type {report_missing_types, boolean()@}} %% </dt> %% <dd>If the value is `true', warnings are issued for missing types. @@ -563,6 +562,7 @@ read_source(Name) -> %% `no_report_missing_types' is an alias for %% `{report_missing_types, false}'. %% </dd> +%% </dl> %% %% @see get_doc/2 %% @see //syntax_tools/erl_syntax diff --git a/lib/edoc/src/edoc_layout.erl b/lib/edoc/src/edoc_layout.erl index b67ec31ae3..f723cd8373 100644 --- a/lib/edoc/src/edoc_layout.erl +++ b/lib/edoc/src/edoc_layout.erl @@ -180,7 +180,9 @@ layout_module(#xmlElement{name = module, content = Es}=E, Opts) -> FullDesc = get_content(fullDescription, Desc), Functions = [{function_name(E), E} || E <- get_content(functions, Es)], Types = [{type_name(E), E} || E <- get_content(typedecls, Es)], - SortedFs = lists:sort(Functions), + SortedFs = if Opts#opts.sort_functions -> lists:sort(Functions); + true -> Functions + end, Body = (navigation("top") ++ [?NL, hr, ?NL, ?NL, {h1, Title}, ?NL] ++ doc_index(FullDesc, Functions, Types) @@ -204,9 +206,7 @@ layout_module(#xmlElement{name = module, content = Es}=E, Opts) -> end ++ types(lists:sort(Types), Opts) ++ function_index(SortedFs, Opts#opts.index_columns) - ++ if Opts#opts.sort_functions -> functions(SortedFs, Opts); - true -> functions(Functions, Opts) - end + ++ functions(SortedFs, Opts) ++ [hr, ?NL] ++ navigation("bottom") ++ timestamp()), diff --git a/lib/edoc/src/edoc_specs.erl b/lib/edoc/src/edoc_specs.erl index bb98e8b04f..f2e5891c2e 100644 --- a/lib/edoc/src/edoc_specs.erl +++ b/lib/edoc/src/edoc_specs.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2015. 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. @@ -270,12 +270,8 @@ parms([], []) -> parms([A | As], [D | Ds]) -> [param(A, D) | parms(As, Ds)]. -param(#t_list{type = Type}, Default) -> - param(Type, Default); param(#t_paren{type = Type}, Default) -> param(Type, Default); -param(#t_nonempty_list{type = Type}, Default) -> - param(Type, Default); param(#t_record{name = #t_atom{val = Name}}, _Default) -> list_to_atom(capitalize(atom_to_list(Name))); param(T, Default) -> diff --git a/lib/edoc/test/Makefile b/lib/edoc/test/Makefile index 2033e003b3..7a03ddeba9 100644 --- a/lib/edoc/test/Makefile +++ b/lib/edoc/test/Makefile @@ -25,7 +25,7 @@ RELSYSDIR = $(RELEASE_PATH)/edoc_test # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +ERL_COMPILE_FLAGS += EBIN = . diff --git a/lib/edoc/test/edoc_SUITE.erl b/lib/edoc/test/edoc_SUITE.erl index 2e2d5584f0..00d7550bed 100644 --- a/lib/edoc/test/edoc_SUITE.erl +++ b/lib/edoc/test/edoc_SUITE.erl @@ -16,7 +16,7 @@ %% -module(edoc_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Test server specific exports -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/lib/eldap/src/eldap.erl b/lib/eldap/src/eldap.erl index ae47c815c9..df87ddde08 100644 --- a/lib/eldap/src/eldap.erl +++ b/lib/eldap/src/eldap.erl @@ -242,7 +242,7 @@ modify_dn(Handle, Entry, NewRDN, DelOldRDN, NewSup) %%% Sanity checks ! -bool_p(Bool) when Bool==true;Bool==false -> Bool. +bool_p(Bool) when is_boolean(Bool) -> Bool. optional([]) -> asn1_NOVALUE; optional(Value) -> Value. @@ -1022,10 +1022,13 @@ log(_, _, _, _) -> %%% Misc. routines %%% -------------------------------------------------------------------- -send(To,Msg) -> To ! {self(),Msg}. +send(To,Msg) -> + To ! {self(), Msg}, + ok. + recv(From) -> receive - {From,Msg} -> Msg; + {From, Msg} -> Msg; {'EXIT', From, Reason} -> {error, {internal_error, Reason}} end. diff --git a/lib/eldap/test/eldap_basic_SUITE.erl b/lib/eldap/test/eldap_basic_SUITE.erl index 638a609346..8efed3cc18 100644 --- a/lib/eldap/test/eldap_basic_SUITE.erl +++ b/lib/eldap/test/eldap_basic_SUITE.erl @@ -23,7 +23,7 @@ -compile(export_all). %%-include_lib("common_test/include/ct.hrl"). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("eldap/include/eldap.hrl"). -include_lib("eldap/ebin/ELDAPv3.hrl"). diff --git a/lib/erl_docgen/priv/css/otp_doc.css b/lib/erl_docgen/priv/css/otp_doc.css index 0b531db701..347782eb1e 100644 --- a/lib/erl_docgen/priv/css/otp_doc.css +++ b/lib/erl_docgen/priv/css/otp_doc.css @@ -37,7 +37,7 @@ a:visited { color: blue; text-decoration: none } top: 0; bottom: 0; left: 0; - width: 200px; + width: 300px; overflow:auto; margin: 0; padding: 1px; @@ -45,7 +45,7 @@ a:visited { color: blue; text-decoration: none } } #content { - margin-left: 240px; /* set left value to WidthOfFrameDiv */ + margin-left: 340px; /* set left value to WidthOfFrameDiv */ } .frontpage diff --git a/lib/erl_docgen/src/docgen_otp_specs.erl b/lib/erl_docgen/src/docgen_otp_specs.erl index 37baa7c2f9..e154323f07 100644 --- a/lib/erl_docgen/src/docgen_otp_specs.erl +++ b/lib/erl_docgen/src/docgen_otp_specs.erl @@ -729,5 +729,9 @@ annos_type([E=#xmlElement{name = typevar}]) -> annos_elem(E); annos_type([#xmlElement{name = paren, content = Es}]) -> annos(get_elem(type, Es)); +annos_type([#xmlElement{name = map, content = Es}]) -> + lists:flatmap(fun(E) -> annos_type([E]) end, Es); +annos_type([#xmlElement{name = map_field, content = Es}]) -> + lists:flatmap(fun annos_elem/1, get_elem(type,Es)); annos_type(_) -> []. diff --git a/lib/erl_docgen/test/Makefile b/lib/erl_docgen/test/Makefile index 9f4cc04105..9e58157023 100644 --- a/lib/erl_docgen/test/Makefile +++ b/lib/erl_docgen/test/Makefile @@ -25,7 +25,7 @@ RELSYSDIR = $(RELEASE_PATH)/erl_docgen_test # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +ERL_COMPILE_FLAGS += EBIN = . diff --git a/lib/erl_interface/doc/src/ei.xml b/lib/erl_interface/doc/src/ei.xml index 6044ac8ef7..8ef433d10f 100644 --- a/lib/erl_interface/doc/src/ei.xml +++ b/lib/erl_interface/doc/src/ei.xml @@ -264,9 +264,9 @@ typedef enum { <fsummary>Encode an atom</fsummary> <desc> <p>Encodes an atom in the binary format with character encoding - <c><seealso marker="#erlang_char_encoding">to_enc</seealso></c> (latin1 or utf8). + <seealso marker="#erlang_char_encoding"><c>to_enc</c></seealso> (latin1 or utf8). The <c>p</c> parameter is the name of the atom with character encoding - <c><seealso marker="#erlang_char_encoding">from_enc</seealso></c> (ascii, latin1 or utf8). + <seealso marker="#erlang_char_encoding"><c>from_enc</c></seealso> (ascii, latin1 or utf8). The name must either be zero-terminated or a function variant with a <c>len</c> parameter must be used. If <c>to_enc</c> is set to the bitwise-or'd combination <c>(ERLANG_LATIN1|ERLANG_UTF8)</c>, utf8 encoding is only used if the atom string @@ -569,8 +569,8 @@ ei_x_encode_string(&x, "Banana"); <p>This function decodes an atom from the binary format. The null terminated name of the atom is placed in buffer at <c>p</c> of length <c>plen</c> bytes.</p> - <p>The wanted string encoding is specified by <c><seealso marker="#erlang_char_encoding"> - want</seealso></c>. The original encoding used in the + <p>The wanted string encoding is specified by <seealso marker="#erlang_char_encoding"> + <c>want</c></seealso>. The original encoding used in the binary format (latin1 or utf8) can be obtained from <c>*was</c>. The actual encoding of the resulting string (7-bit ascii, latin1 or utf8) can be obtained from <c>*result</c>. Both <c>was</c> and <c>result</c> can be <c>NULL</c>. diff --git a/lib/erl_interface/doc/src/erl_call.xml b/lib/erl_interface/doc/src/erl_call.xml index aed1ba0ac9..e982bf89e1 100644 --- a/lib/erl_interface/doc/src/erl_call.xml +++ b/lib/erl_interface/doc/src/erl_call.xml @@ -178,7 +178,7 @@ erl_call -s -a 'erlang halt' -n madonna <code type="none"><![CDATA[ erl_call -s -a 'lists map [{math,sqrt},[1,4,9,16,25]]' -n madonna ]]></code> - <p>Evaluates a couple of expressions. <b>The input ends with EOF (Control-D)</b>.</p> + <p>Evaluates a couple of expressions. <em>The input ends with EOF (Control-D)</em>.</p> <code type="none"><![CDATA[ erl_call -s -e -n madonna statistics(runtime), @@ -189,7 +189,7 @@ Y=2, ^D {ok,{3,0}} ]]></code> - <p>Compiles a module and runs it. <b>Again, the input ends with EOF (Control-D)</b>. (In the example shown, the output has been formatted afterwards).</p> + <p>Compiles a module and runs it. <em>Again, the input ends with EOF (Control-D)</em>. (In the example shown, the output has been formatted afterwards).</p> <code type="none"><![CDATA[ erl_call -s -m -a lolita -n madonna -module(lolita). diff --git a/lib/erl_interface/doc/src/erl_eterm.xml b/lib/erl_interface/doc/src/erl_eterm.xml index 9a53a137c2..713a90a390 100644 --- a/lib/erl_interface/doc/src/erl_eterm.xml +++ b/lib/erl_interface/doc/src/erl_eterm.xml @@ -78,10 +78,12 @@ </p> <taglist> <tag><c><![CDATA[char *ERL_ATOM_PTR(t)]]></c></tag> + <item/> <tag><c><![CDATA[char *ERL_ATOM_PTR_UTF8(t)]]></c></tag> <item>A string representing atom <c><![CDATA[t]]></c>. </item> <tag><c><![CDATA[int ERL_ATOM_SIZE(t)]]></c></tag> + <item/> <tag><c><![CDATA[int ERL_ATOM_SIZE_UTF8(t)]]></c></tag> <item>The length (in bytes) of atom t.</item> <tag><c><![CDATA[void *ERL_BIN_PTR(t)]]></c></tag> @@ -95,6 +97,7 @@ <tag><c><![CDATA[double ERL_FLOAT_VALUE(t)]]></c></tag> <item>The floating point value of <c><![CDATA[t]]></c>.</item> <tag><c><![CDATA[ETERM *ERL_PID_NODE(t)]]></c></tag> + <item/> <tag><c><![CDATA[ETERM *ERL_PID_NODE_UTF8(t)]]></c></tag> <item>The Node in pid <c><![CDATA[t]]></c>.</item> <tag><c><![CDATA[int ERL_PID_NUMBER(t)]]></c></tag> @@ -108,6 +111,7 @@ <tag><c><![CDATA[int ERL_PORT_CREATION(t)]]></c></tag> <item>The creation number in port <c><![CDATA[t]]></c>.</item> <tag><c><![CDATA[ETERM *ERL_PORT_NODE(t)]]></c></tag> + <item/> <tag><c><![CDATA[ETERM *ERL_PORT_NODE_UTF8(t)]]></c></tag> <item>The node in port <c><![CDATA[t]]></c>.</item> <tag><c><![CDATA[int ERL_REF_NUMBER(t)]]></c></tag> diff --git a/lib/erl_interface/src/Makefile.in b/lib/erl_interface/src/Makefile.in index 777d709b1e..d6176ec053 100644 --- a/lib/erl_interface/src/Makefile.in +++ b/lib/erl_interface/src/Makefile.in @@ -126,11 +126,7 @@ else WARNFLAGS = @WFLAGS@ endif -ifneq ($(findstring ose,$(TARGET)),ose) CFLAGS = @LIB_CFLAGS@ $(WARNFLAGS) $(INCFLAGS) $(TYPE_FLAGS) -else -CFLAGS = @CFLAGS@ $(INCFLAGS) -endif PROG_CFLAGS = @CFLAGS@ $(WARNFLAGS) $(INCFLAGS) $(TYPE_FLAGS) -Ilegacy ifeq ($(findstring vxworks,$(TARGET)),vxworks) @@ -210,12 +206,8 @@ MDD_ERLLIB = $(OBJDIR)/$(LIBPRE)erl_interface_mdd$(LIBEXT) # Specify targets to build ########################################################################### -ifneq ($(findstring ose,$(TARGET)),ose) EXE_TARGETS = \ $(ERL_CALL) -else -EXE_TARGETS = -endif ifeq ($(USING_VC),yes) @@ -480,44 +472,6 @@ ERLSOURCES = \ SOURCES = $(EISOURCES) $(ERLSOURCES) -OSE_EISOURCES = \ - $(DECODESRC) \ - $(ENCODESRC) \ - misc/ei_decode_term.c \ - misc/ei_format.c \ - misc/ei_locking.c \ - misc/ei_malloc.c \ - misc/ei_printterm.c \ - misc/ei_pthreads.c \ - misc/ei_trace.c \ - misc/ei_x_encode.c \ - misc/eimd5.c \ - misc/get_type.c \ - misc/show_msg.c \ - misc/ei_compat.c \ - registry/hash_dohash.c \ - registry/hash_foreach.c \ - registry/hash_freetab.c \ - registry/hash_insert.c \ - registry/hash_isprime.c \ - registry/hash_lookup.c \ - registry/hash_newtab.c \ - registry/hash_remove.c \ - registry/hash_resize.c \ - registry/hash_rlookup.c - -OSE_ERLSOURCES = \ - legacy/decode_term.c \ - legacy/encode_term.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 - -OSE_SOURCES = $(OSE_EISOURCES) $(OSE_ERLSOURCES) - NEVERUSED = \ whereis.c \ ei_send.c \ @@ -532,13 +486,8 @@ ERLCALL = \ # Note that encode/decode_term.c defines ei functions that is # located in the erl_interface library, not ei library. -ifneq ($(findstring ose,$(TARGET)),ose) ST_EIOBJECTS = $(addprefix $(ST_OBJDIR)/,$(notdir $(EISOURCES:.c=.o))) ST_ERLOBJECTS = $(addprefix $(ST_OBJDIR)/,$(notdir $(ERLSOURCES:.c=.o))) -else -ST_EIOBJECTS = $(addprefix $(ST_OBJDIR)/,$(notdir $(OSE_EISOURCES:.c=.o))) -ST_ERLOBJECTS = $(addprefix $(ST_OBJDIR)/,$(notdir $(OSE_ERLSOURCES:.c=.o))) -endif 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))) @@ -587,14 +536,6 @@ $(TARGET)/config.h: $(V_at)echo "#define HAVE_SOCKLEN_T 1" >> $@ endif -ifeq ($(findstring ose,$(TARGET)),ose) -$(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 ########################################################################### @@ -719,9 +660,6 @@ $(ST_OBJDIR)/erl_start.o: prog/erl_start.c $(V_CC) $(CFLAGS) -c $< -o $@ else -ifeq ($(findstring ose,$(TARGET)),ose) -$(ERL_CALL): -else ifdef THR_DEFS $(ERL_CALL): $(ERLCALL) ../include/ei.h $(MT_EILIB) $(ld_verbose)$(PURIFY) $(CC) $(PROG_CFLAGS) $(THR_DEFS) $(LDFLAGS) -o $@ $(ERLCALL) \ @@ -733,7 +671,6 @@ $(ERL_CALL): $(ERLCALL) ../include/ei.h $(ST_EILIB) endif endif endif -endif ########################################################################### # Fake application targets used to test header files and linking diff --git a/lib/erl_interface/src/connect/ei_resolve.c b/lib/erl_interface/src/connect/ei_resolve.c index 6381b02393..414cb8be3e 100644 --- a/lib/erl_interface/src/connect/ei_resolve.c +++ b/lib/erl_interface/src/connect/ei_resolve.c @@ -601,16 +601,6 @@ struct hostent *ei_gethostbyaddr(const char *addr, int len, int type) return gethostbyaddr(addr, len, type); } -/* - * Imprecise way to select the actually available gethostbyname_r and - * gethostbyaddr_r. - * - * TODO: check this properly in configure.in - */ -#if (defined(__linux__) || (__FreeBSD_version >= 602000) || defined(__DragonFly__)) - #define HAVE_GETHOSTBYADDR_R_8 1 -#endif - struct hostent *ei_gethostbyaddr_r(const char *addr, int length, int type, @@ -626,7 +616,7 @@ struct hostent *ei_gethostbyaddr_r(const char *addr, #ifndef HAVE_GETHOSTBYNAME_R return my_gethostbyaddr_r(addr,length,type,hostp,buffer,buflen,h_errnop); #else -#ifdef HAVE_GETHOSTBYADDR_R_8 +#if (defined(__GLIBC__) || defined(__linux__) || (__FreeBSD_version >= 602000) || defined(__DragonFly__)) struct hostent *result; gethostbyaddr_r(addr, length, type, hostp, buffer, buflen, &result, @@ -653,7 +643,7 @@ struct hostent *ei_gethostbyname_r(const char *name, #ifndef HAVE_GETHOSTBYNAME_R return my_gethostbyname_r(name,hostp,buffer,buflen,h_errnop); #else -#ifdef HAVE_GETHOSTBYADDR_R_8 +#if (defined(__GLIBC__) || defined(__linux__) || (__FreeBSD_version >= 602000) || defined(__DragonFly__) || defined(__ANDROID__)) struct hostent *result; gethostbyname_r(name, hostp, buffer, buflen, &result, h_errnop); diff --git a/lib/erl_interface/test/ei_accept_SUITE.erl b/lib/erl_interface/test/ei_accept_SUITE.erl index 144ec99e0a..db3587339e 100644 --- a/lib/erl_interface/test/ei_accept_SUITE.erl +++ b/lib/erl_interface/test/ei_accept_SUITE.erl @@ -21,7 +21,7 @@ %% -module(ei_accept_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("ei_accept_SUITE_data/ei_accept_test_cases.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/lib/erl_interface/test/ei_connect_SUITE.erl b/lib/erl_interface/test/ei_connect_SUITE.erl index 3385d1eb6c..c94ac37af4 100644 --- a/lib/erl_interface/test/ei_connect_SUITE.erl +++ b/lib/erl_interface/test/ei_connect_SUITE.erl @@ -21,7 +21,7 @@ %% -module(ei_connect_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("ei_connect_SUITE_data/ei_connect_test_cases.hrl"). -export([ diff --git a/lib/erl_interface/test/ei_decode_SUITE.erl b/lib/erl_interface/test/ei_decode_SUITE.erl index 0abcf50fb5..91357c99f2 100644 --- a/lib/erl_interface/test/ei_decode_SUITE.erl +++ b/lib/erl_interface/test/ei_decode_SUITE.erl @@ -21,7 +21,7 @@ %% -module(ei_decode_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("ei_decode_SUITE_data/ei_decode_test_cases.hrl"). -export( diff --git a/lib/erl_interface/test/ei_decode_encode_SUITE.erl b/lib/erl_interface/test/ei_decode_encode_SUITE.erl index 3c7e4bf70d..6a25b98209 100644 --- a/lib/erl_interface/test/ei_decode_encode_SUITE.erl +++ b/lib/erl_interface/test/ei_decode_encode_SUITE.erl @@ -21,7 +21,7 @@ %% -module(ei_decode_encode_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("ei_decode_encode_SUITE_data/ei_decode_encode_test_cases.hrl"). -export( diff --git a/lib/erl_interface/test/ei_encode_SUITE.erl b/lib/erl_interface/test/ei_encode_SUITE.erl index 6213916314..d94f3adf42 100644 --- a/lib/erl_interface/test/ei_encode_SUITE.erl +++ b/lib/erl_interface/test/ei_encode_SUITE.erl @@ -21,7 +21,7 @@ %% -module(ei_encode_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("ei_encode_SUITE_data/ei_encode_test_cases.hrl"). -export( diff --git a/lib/erl_interface/test/ei_format_SUITE.erl b/lib/erl_interface/test/ei_format_SUITE.erl index 11cbae31db..ed6a755f9b 100644 --- a/lib/erl_interface/test/ei_format_SUITE.erl +++ b/lib/erl_interface/test/ei_format_SUITE.erl @@ -21,7 +21,7 @@ %% -module(ei_format_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("ei_format_SUITE_data/ei_format_test_cases.hrl"). -export([ diff --git a/lib/erl_interface/test/ei_print_SUITE.erl b/lib/erl_interface/test/ei_print_SUITE.erl index 4309b883bb..36ee90c7ee 100644 --- a/lib/erl_interface/test/ei_print_SUITE.erl +++ b/lib/erl_interface/test/ei_print_SUITE.erl @@ -21,7 +21,7 @@ %% -module(ei_print_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("ei_print_SUITE_data/ei_print_test_cases.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/lib/erl_interface/test/ei_tmo_SUITE.erl b/lib/erl_interface/test/ei_tmo_SUITE.erl index 689499f42f..f506b3dbb0 100644 --- a/lib/erl_interface/test/ei_tmo_SUITE.erl +++ b/lib/erl_interface/test/ei_tmo_SUITE.erl @@ -21,7 +21,7 @@ %% -module(ei_tmo_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/inet.hrl"). -include("ei_tmo_SUITE_data/ei_tmo_test_cases.hrl"). diff --git a/lib/erl_interface/test/erl_connect_SUITE.erl b/lib/erl_interface/test/erl_connect_SUITE.erl index f621310a1c..d3fe020bce 100644 --- a/lib/erl_interface/test/erl_connect_SUITE.erl +++ b/lib/erl_interface/test/erl_connect_SUITE.erl @@ -21,7 +21,7 @@ %% -module(erl_connect_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("erl_connect_SUITE_data/erl_connect_test_cases.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/lib/erl_interface/test/erl_eterm_SUITE.erl b/lib/erl_interface/test/erl_eterm_SUITE.erl index 8fbef35309..230310f63b 100644 --- a/lib/erl_interface/test/erl_eterm_SUITE.erl +++ b/lib/erl_interface/test/erl_eterm_SUITE.erl @@ -21,7 +21,7 @@ %% -module(erl_eterm_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("erl_eterm_SUITE_data/eterm_test_cases.hrl"). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/erl_interface/test/erl_ext_SUITE.erl b/lib/erl_interface/test/erl_ext_SUITE.erl index f73c15e15f..cbc93b4cfb 100644 --- a/lib/erl_interface/test/erl_ext_SUITE.erl +++ b/lib/erl_interface/test/erl_ext_SUITE.erl @@ -21,7 +21,7 @@ %% -module(erl_ext_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("erl_ext_SUITE_data/ext_test_cases.hrl"). -export([ diff --git a/lib/erl_interface/test/erl_format_SUITE.erl b/lib/erl_interface/test/erl_format_SUITE.erl index 8c01a9914f..afbbe6a241 100644 --- a/lib/erl_interface/test/erl_format_SUITE.erl +++ b/lib/erl_interface/test/erl_format_SUITE.erl @@ -21,7 +21,7 @@ %% -module(erl_format_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("erl_format_SUITE_data/format_test_cases.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/lib/erl_interface/test/erl_global_SUITE.erl b/lib/erl_interface/test/erl_global_SUITE.erl index b719ad5c6a..493ad576c9 100644 --- a/lib/erl_interface/test/erl_global_SUITE.erl +++ b/lib/erl_interface/test/erl_global_SUITE.erl @@ -21,7 +21,7 @@ %% -module(erl_global_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("erl_global_SUITE_data/erl_global_test_cases.hrl"). -export([all/0,suite/0,init_per_suite/1,end_per_suite/1, diff --git a/lib/erl_interface/test/erl_match_SUITE.erl b/lib/erl_interface/test/erl_match_SUITE.erl index d8f7bd89b4..ecdebad212 100644 --- a/lib/erl_interface/test/erl_match_SUITE.erl +++ b/lib/erl_interface/test/erl_match_SUITE.erl @@ -21,7 +21,7 @@ %% -module(erl_match_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("erl_match_SUITE_data/match_test_cases.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/lib/erl_interface/test/port_call_SUITE.erl b/lib/erl_interface/test/port_call_SUITE.erl index b0f5ed4fe9..3bc1a03eab 100644 --- a/lib/erl_interface/test/port_call_SUITE.erl +++ b/lib/erl_interface/test/port_call_SUITE.erl @@ -34,7 +34,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, basic/1]). % Private exports --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/eunit/src/eunit_data.erl b/lib/eunit/src/eunit_data.erl index 8b53a3681d..cc002cb449 100644 --- a/lib/eunit/src/eunit_data.erl +++ b/lib/eunit/src/eunit_data.erl @@ -761,6 +761,7 @@ lazy_test_() -> lazy_gen(7), ?_assertMatch(7, get(count))]}. +-dialyzer({no_improper_lists, lazy_gen/1}). lazy_gen(N) -> {generator, fun () -> diff --git a/lib/eunit/src/eunit_lib.erl b/lib/eunit/src/eunit_lib.erl index d8f98cffa5..4dbe023257 100644 --- a/lib/eunit/src/eunit_lib.erl +++ b/lib/eunit/src/eunit_lib.erl @@ -192,6 +192,7 @@ error_msg(Title, Fmt, Args) -> io_lib:fwrite("*** ~ts ***\n~ts\n\n", [Title, Msg]). -ifdef(TEST). +-dialyzer({no_match, format_exception_test_/0}). format_exception_test_() -> [?_assertMatch( "\nymmud:rorre"++_, @@ -273,6 +274,7 @@ dlist_next([], Xs) -> -ifdef(TEST). +-dialyzer({no_match, dlist_test_/0}). dlist_test_() -> {"deep list traversal", [{"non-list term -> singleton list", @@ -338,6 +340,7 @@ is_nonempty_string([]) -> false; is_nonempty_string(Cs) -> is_string(Cs). -ifdef(TEST). +-dialyzer({no_match, is_string_test_/0}). is_string_test_() -> {"is_string", [{"no non-lists", ?_assert(not is_string($A))}, @@ -399,6 +402,7 @@ uniq([X | Xs]) -> [X | uniq(Xs)]; uniq([]) -> []. -ifdef(TEST). +-dialyzer({[no_match, no_fail_call, no_improper_lists], uniq_test_/0}). uniq_test_() -> {"uniq", [?_assertError(function_clause, uniq(ok)), @@ -459,6 +463,7 @@ normalize([]) -> -ifdef(TEST). +-dialyzer({no_match, cmd_test_/0}). cmd_test_() -> ([?_test({0, "hello\n"} = ?_cmd_("echo hello"))] ++ case os:type() of @@ -576,6 +581,7 @@ trie_match([], _T) -> -ifdef(TEST). +-dialyzer({no_match, trie_test_/0}). trie_test_() -> [{"basic representation", [?_assert(trie_new() =:= gb_trees:empty()), diff --git a/lib/eunit/src/eunit_listener.erl b/lib/eunit/src/eunit_listener.erl index ecaac424a2..c34eacb1d6 100644 --- a/lib/eunit/src/eunit_listener.erl +++ b/lib/eunit/src/eunit_listener.erl @@ -27,14 +27,11 @@ -export([start/1, start/2]). --export([behaviour_info/1]). - - -behaviour_info(callbacks) -> - [{init,1},{handle_begin,3},{handle_end,3},{handle_cancel,3}, - {terminate,2}]; -behaviour_info(_Other) -> - undefined. +-callback init(_) -> _. +-callback handle_begin(_, _, _) -> _. +-callback handle_end(_, _, _) -> _. +-callback handle_cancel(_, _, _) -> _. +-callback terminate(_, _) -> _. -record(state, {callback, % callback module @@ -50,18 +47,22 @@ start(Callback) -> start(Callback, Options) -> St = #state{callback = Callback}, - spawn_opt(fun () -> init(St, Options) end, + spawn_opt(init_fun(St, Options), proplists:get_all_values(spawn, Options)). -init(St0, Options) -> - St1 = call(init, [Options], St0), - St2 = expect([], undefined, St1), - Data = [{pass, St2#state.pass}, - {fail, St2#state.fail}, - {skip, St2#state.skip}, - {cancel, St2#state.cancel}], - call(terminate, [{ok, Data}, St2#state.state], St2), - exit(normal). +-spec init_fun(_, _) -> fun(() -> no_return()). + +init_fun(St0, Options) -> + fun () -> + St1 = call(init, [Options], St0), + St2 = expect([], undefined, St1), + Data = [{pass, St2#state.pass}, + {fail, St2#state.fail}, + {skip, St2#state.skip}, + {cancel, St2#state.cancel}], + call(terminate, [{ok, Data}, St2#state.state], St2), + exit(normal) + end. expect(Id, ParentId, St) -> case wait_for(Id, 'begin', ParentId) of diff --git a/lib/eunit/src/eunit_proc.erl b/lib/eunit/src/eunit_proc.erl index 98ae31d54b..8bdf94c877 100644 --- a/lib/eunit/src/eunit_proc.erl +++ b/lib/eunit/src/eunit_proc.erl @@ -268,6 +268,8 @@ insulator_wait(Child, Parent, Buf, St) -> kill_task(Child, St) end. +-spec kill_task(_, _) -> no_return(). + kill_task(Child, St) -> exit(Child, kill), terminate_insulator(St). diff --git a/lib/eunit/src/eunit_serial.erl b/lib/eunit/src/eunit_serial.erl index 1a0179a5df..da76064a53 100644 --- a/lib/eunit/src/eunit_serial.erl +++ b/lib/eunit/src/eunit_serial.erl @@ -61,14 +61,16 @@ messages = dict:new() :: dict:dict()}). start(Pids) -> - spawn(fun () -> serializer(Pids) end). - -serializer(Pids) -> - St = #state{listeners = sets:from_list(Pids), - cancelled = eunit_lib:trie_new(), - messages = dict:new()}, - expect([], undefined, 0, St), - exit(normal). + spawn(serializer_fun(Pids)). + +serializer_fun(Pids) -> + fun () -> + St = #state{listeners = sets:from_list(Pids), + cancelled = eunit_lib:trie_new(), + messages = dict:new()}, + expect([], undefined, 0, St), + exit(normal) + end. %% collect beginning and end of an expected item; return {Done, NewSt} %% where Done is true if there are no more items of this group diff --git a/lib/eunit/src/eunit_surefire.erl b/lib/eunit/src/eunit_surefire.erl index f3e58a3d1c..1b468551d8 100644 --- a/lib/eunit/src/eunit_surefire.erl +++ b/lib/eunit/src/eunit_surefire.erl @@ -56,7 +56,11 @@ { name :: chars(), description :: chars(), - result :: ok | {failed, tuple()} | {aborted, tuple()} | {skipped, term()}, + result :: ok + | {failed, tuple()} + | {aborted, tuple()} + | {skipped, term()} + | undefined, time :: integer(), output :: binary() }). diff --git a/lib/eunit/src/eunit_test.erl b/lib/eunit/src/eunit_test.erl index 9cf40a738d..62d30b1930 100644 --- a/lib/eunit/src/eunit_test.erl +++ b/lib/eunit/src/eunit_test.erl @@ -40,6 +40,7 @@ get_stacktrace() -> get_stacktrace(Ts) -> eunit_lib:uniq(prune_trace(erlang:get_stacktrace(), Ts)). +-dialyzer({no_match, prune_trace/2}). prune_trace([{eunit_data, _, _} | Rest], Tail) -> prune_trace(Rest, Tail); prune_trace([{eunit_data, _, _, _} | Rest], Tail) -> @@ -75,6 +76,7 @@ run_testfun(F) -> -ifdef(TEST). +-dialyzer({[no_match, no_fail_call, no_return], macro_test_/0}). macro_test_() -> {"macro definitions", [{?LINE, fun () -> @@ -301,6 +303,7 @@ wrapper_test_() -> ]}. %% this must be exported (done automatically by the autoexport transform) +-dialyzer({no_missing_calls, wrapper_test_exported_/0}). wrapper_test_exported_() -> {ok, ?MODULE:nonexisting_function()}. -endif. diff --git a/lib/eunit/src/eunit_tests.erl b/lib/eunit/src/eunit_tests.erl index 47ea0aaf46..5dee1cb49e 100644 --- a/lib/eunit/src/eunit_tests.erl +++ b/lib/eunit/src/eunit_tests.erl @@ -23,6 +23,8 @@ -include("eunit.hrl"). +-dialyzer(no_match). + -ifdef(TEST). id(X) -> X. % for suppressing compiler warnings -endif. diff --git a/lib/eunit/test/Makefile b/lib/eunit/test/Makefile index 8721bacf89..6f166f99aa 100644 --- a/lib/eunit/test/Makefile +++ b/lib/eunit/test/Makefile @@ -41,8 +41,8 @@ RELSYSDIR = $(RELEASE_PATH)/eunit_test # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- -ERL_MAKE_FLAGS += -pa $(ERL_TOP)/lib/test_server/ebin -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +ERL_MAKE_FLAGS += +ERL_COMPILE_FLAGS += EBIN = . diff --git a/lib/gs/Makefile b/lib/gs/Makefile index 02c8fc3467..b95d435461 100644 --- a/lib/gs/Makefile +++ b/lib/gs/Makefile @@ -26,7 +26,7 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk # Macros # -SUB_DIRECTORIES = src tcl contribs examples doc/src +SUB_DIRECTORIES = src tcl examples doc/src include vsn.mk VSN = $(GS_VSN) diff --git a/lib/gs/contribs/Makefile b/lib/gs/contribs/Makefile deleted file mode 100644 index 061fae86c1..0000000000 --- a/lib/gs/contribs/Makefile +++ /dev/null @@ -1,32 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1996-2009. 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_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -SUB_DIRECTORIES = bonk cols mandel othello -SPECIAL_TARGETS = - -# -# Default Subdir Targets -# -include $(ERL_TOP)/make/otp_subdir.mk - diff --git a/lib/gs/contribs/bonk/Makefile b/lib/gs/contribs/bonk/Makefile deleted file mode 100644 index b7508a97c9..0000000000 --- a/lib/gs/contribs/bonk/Makefile +++ /dev/null @@ -1,109 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1996-2012. 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_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../../vsn.mk -VSN=$(GS_VSN) - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/gs-$(VSN)/contribs - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- - -MODULES= \ - bonk \ - bonk_sound \ - bonk_square \ - sounder - -HRL_FILES= -ERL_FILES= $(MODULES:%=%.erl) - -TARGET_FILES= $(MODULES:%=../ebin/%.$(EMULATOR)) $(TARGET_TOOLBOX_FILES) - -BITMAPS= bitmaps/bonkbomb bitmaps/bonkface bitmaps/bonklogo bitmaps/bonkmiss \ - bitmaps/bonktom bitmaps/bonkx bitmaps/erl-e bitmaps/erl-text -SOUNDS= sounds/bonk.au sounds/damn.au sounds/explosion.au sounds/gameover.au \ - sounds/hehee.au sounds/level.au sounds/missedme.au sounds/music.au \ - sounds/ouch!!!.au sounds/praisejesus.au sounds/trumpet.au sounds/yes.au - -TOOLNAME = bonk - -EXTRA_FILES= $(TOOLNAME).txt -TOOLBOX_FILES= $(TOOLNAME).tool $(TOOLNAME).gif -TARGET_TOOLBOX_FILES= $(TOOLBOX_FILES:%=$(EBIN)/%) - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -ERL_COMPILE_FLAGS += - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -debug opt: $(TARGET_FILES) - -docs: - -clean: - rm -f $(TARGET_FILES) - rm -f core - -# ---------------------------------------------------- -# Special Build Targets -# ---------------------------------------------------- - -$(EBIN)/$(TOOLNAME).gif: $(TOOLNAME).gif - $(gen_verbose)rm -f $@ - $(V_at)cp $(TOOLNAME).gif $@ - -$(EBIN)/$(TOOLNAME).tool: $(TOOLNAME).tool - $(gen_verbose)rm -f $@ - $(V_at)cp $(TOOLNAME).tool $@ - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_spec: opt - $(INSTALL_DIR) "$(RELSYSDIR)/ebin" - $(INSTALL_DATA) $(TARGET_FILES) "$(RELSYSDIR)/ebin" - $(INSTALL_DIR) "$(RELSYSDIR)/bonk/bitmaps" - $(INSTALL_DATA) $(BITMAPS) $(TOOLBOX_FILES) "$(RELSYSDIR)/bonk/bitmaps" - $(INSTALL_DIR) "$(RELSYSDIR)/bonk/sounds" - $(INSTALL_DATA) $(SOUNDS) "$(RELSYSDIR)/bonk/sounds" - $(INSTALL_DIR) "$(RELSYSDIR)/bonk" - $(INSTALL_DATA) $(ERL_FILES) $(EXTRA_FILES) "$(RELSYSDIR)/bonk" - - -release_docs_spec: - diff --git a/lib/gs/contribs/bonk/bitmaps/bonkbomb b/lib/gs/contribs/bonk/bitmaps/bonkbomb deleted file mode 100644 index 8b121db9e8..0000000000 --- a/lib/gs/contribs/bonk/bitmaps/bonkbomb +++ /dev/null @@ -1,66 +0,0 @@ -#define bonkbomb_width 75 -#define bonkbomb_height 75 -static char bonkbomb_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x04, 0x10, 0x82, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x08, - 0x10, 0x42, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x10, 0x10, 0x21, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x20, 0x10, 0x11, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x40, 0x90, 0x08, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x80, 0x90, 0x04, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x04, 0x51, 0x82, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x18, - 0x12, 0x61, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x60, 0x94, 0x18, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x41, 0x06, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xfc, 0xbb, 0xff, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x18, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, - 0x99, 0x04, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x60, 0x18, 0x19, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x18, 0x30, 0x62, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x04, 0x30, 0x84, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x80, 0x30, 0x08, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xc0, 0x31, 0x10, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, - 0x3b, 0x20, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x70, 0x1f, 0x40, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x03, 0xb8, 0x0e, 0x80, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xfc, 0x7f, 0x5c, 0x1d, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xff, 0xff, 0xaf, 0x3a, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xff, - 0xff, 0x57, 0x35, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xff, 0xff, 0xaf, - 0x3a, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x5f, 0x1d, 0x00, - 0x00, 0x00, 0x00, 0x00, 0xf8, 0xff, 0xff, 0xbf, 0x0e, 0x00, 0x00, 0x00, - 0x00, 0x00, 0xfc, 0xff, 0xff, 0x7f, 0x07, 0x00, 0x00, 0x00, 0x00, 0x00, - 0xfe, 0xff, 0xff, 0xff, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, - 0xff, 0xff, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0xfe, 0xff, 0xff, - 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0xfe, 0xff, 0xff, 0x01, 0x00, - 0x00, 0x00, 0x00, 0x80, 0x7f, 0xfc, 0xff, 0xff, 0x03, 0x00, 0x00, 0x00, - 0x00, 0x80, 0x3f, 0xf8, 0xff, 0xff, 0x03, 0x00, 0x00, 0x00, 0x00, 0x80, - 0x0f, 0xf0, 0xff, 0xff, 0x03, 0x00, 0x00, 0x00, 0x00, 0x80, 0x3f, 0xc0, - 0xff, 0xff, 0x03, 0x00, 0x00, 0x00, 0x00, 0x80, 0x7f, 0xf0, 0xff, 0xff, - 0x03, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xff, 0xf8, 0xff, 0xff, 0x07, 0x00, - 0x00, 0x00, 0x00, 0xc0, 0xff, 0xfd, 0xff, 0xff, 0x07, 0x00, 0x00, 0x00, - 0x00, 0xc0, 0xff, 0xfd, 0xff, 0xff, 0x07, 0x00, 0x00, 0x00, 0x00, 0x80, - 0xff, 0xff, 0xff, 0xff, 0x03, 0x00, 0x00, 0x00, 0x00, 0x80, 0xff, 0xff, - 0xff, 0xff, 0x03, 0x00, 0x00, 0x00, 0x00, 0x80, 0xff, 0xff, 0xff, 0xff, - 0x03, 0x00, 0x00, 0x00, 0x00, 0x80, 0xff, 0xff, 0xff, 0xff, 0x03, 0x00, - 0x00, 0x00, 0x00, 0x80, 0xff, 0xff, 0xff, 0xff, 0x03, 0x00, 0x00, 0x00, - 0x00, 0x00, 0xff, 0xff, 0xff, 0xff, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, - 0xff, 0xff, 0xff, 0xff, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, - 0xff, 0xff, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, 0xff, 0xff, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0xff, 0x7f, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0xf8, 0xff, 0xff, 0x3f, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0xf0, 0xff, 0xff, 0x1f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0xe0, 0xff, 0xff, 0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xff, - 0xff, 0x07, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0xff, 0x01, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x7f, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; diff --git a/lib/gs/contribs/bonk/bitmaps/bonkface b/lib/gs/contribs/bonk/bitmaps/bonkface deleted file mode 100644 index 964fb93098..0000000000 --- a/lib/gs/contribs/bonk/bitmaps/bonkface +++ /dev/null @@ -1,66 +0,0 @@ -#define bonkface_width 75 -#define bonkface_height 75 -static char bonkface_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0x03, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x01, 0x3c, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x18, 0x00, 0xc0, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x06, 0x00, 0x00, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x80, 0x01, 0x00, 0x00, 0x0c, 0x00, 0x00, 0x00, 0x00, 0x00, 0x40, 0x00, - 0x00, 0x00, 0x10, 0x00, 0x00, 0x00, 0x00, 0x00, 0x20, 0x00, 0x00, 0x00, - 0x20, 0x00, 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x00, 0x00, 0x40, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x08, 0x00, 0x00, 0x00, 0x80, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x04, 0x00, 0x00, 0x00, 0x00, 0x01, 0x00, 0x00, 0x00, 0x00, - 0x02, 0x00, 0x00, 0x00, 0x00, 0x02, 0x00, 0x00, 0x00, 0x00, 0x01, 0x08, - 0x00, 0x80, 0x00, 0x04, 0x00, 0x00, 0x00, 0x00, 0x01, 0x30, 0x00, 0x60, - 0x00, 0x04, 0x00, 0x00, 0x00, 0x80, 0x00, 0xc0, 0x00, 0x18, 0x00, 0x08, - 0x00, 0x00, 0x00, 0x80, 0x07, 0x00, 0x03, 0x06, 0x00, 0x0f, 0x00, 0x00, - 0x00, 0x40, 0xff, 0x00, 0x00, 0x00, 0xf8, 0x17, 0x00, 0x00, 0x00, 0x40, - 0xfe, 0x1f, 0x00, 0xc0, 0xff, 0x13, 0x00, 0x00, 0x00, 0x20, 0xf8, 0xff, - 0x03, 0xfe, 0xff, 0x20, 0x00, 0x00, 0x00, 0x20, 0xf0, 0xff, 0xff, 0xff, - 0x7f, 0x20, 0x00, 0x00, 0x00, 0x20, 0xc0, 0xff, 0xdf, 0xff, 0x1f, 0x20, - 0x00, 0x00, 0x00, 0x20, 0x00, 0xff, 0xdf, 0xff, 0x07, 0x20, 0x00, 0x00, - 0x00, 0x10, 0x00, 0xfe, 0x8f, 0xff, 0x03, 0x40, 0x00, 0x00, 0x00, 0x10, - 0x00, 0xf8, 0x8f, 0xff, 0x00, 0x40, 0x00, 0x00, 0x00, 0x10, 0x00, 0xf0, - 0x07, 0x7f, 0x00, 0x40, 0x00, 0x00, 0x00, 0x10, 0x00, 0xc0, 0x07, 0x1f, - 0x00, 0x40, 0x00, 0x00, 0x00, 0x10, 0x00, 0x00, 0x03, 0x06, 0x00, 0x40, - 0x00, 0x00, 0x00, 0x10, 0x00, 0x00, 0x00, 0x00, 0x00, 0x40, 0x00, 0x00, - 0x00, 0x10, 0x00, 0x00, 0x00, 0x00, 0x00, 0x40, 0x00, 0x00, 0x00, 0x10, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x40, 0x00, 0x00, 0x00, 0x10, 0x00, 0xe0, - 0x00, 0x38, 0x00, 0x40, 0x00, 0x00, 0x00, 0x10, 0x10, 0xf0, 0x01, 0x7c, - 0x40, 0x40, 0x00, 0x00, 0x00, 0x10, 0x10, 0x00, 0x06, 0x03, 0x40, 0x40, - 0x00, 0x00, 0x00, 0x10, 0x10, 0x00, 0xf8, 0x00, 0x40, 0x40, 0x00, 0x00, - 0x00, 0x10, 0x30, 0x00, 0x00, 0x00, 0x60, 0x40, 0x00, 0x00, 0x00, 0x10, - 0x70, 0x00, 0x00, 0x00, 0x70, 0x40, 0x00, 0x00, 0x00, 0x10, 0xf0, 0x01, - 0x00, 0x00, 0x7c, 0x40, 0x00, 0x00, 0x00, 0x20, 0xf0, 0x0f, 0x00, 0x80, - 0x7f, 0x20, 0x00, 0x00, 0x00, 0x20, 0xf0, 0xff, 0x03, 0xfe, 0x7f, 0x20, - 0x00, 0x00, 0x00, 0x20, 0xf0, 0x7f, 0xfe, 0xff, 0x7f, 0x20, 0x00, 0x00, - 0x00, 0x20, 0xe0, 0x7f, 0xfe, 0xff, 0x3f, 0x20, 0x00, 0x00, 0x00, 0x40, - 0xe0, 0x7f, 0xfe, 0xff, 0x3f, 0x10, 0x00, 0x00, 0x00, 0x40, 0xc0, 0xff, - 0xff, 0xff, 0x1f, 0x10, 0x00, 0x00, 0x00, 0x80, 0xc0, 0xff, 0xff, 0xff, - 0x1f, 0x08, 0x00, 0x00, 0x00, 0x80, 0x80, 0xff, 0xff, 0xff, 0x0f, 0x08, - 0x00, 0x00, 0x00, 0x00, 0x01, 0xff, 0xff, 0xff, 0x07, 0x04, 0x00, 0x00, - 0x00, 0x00, 0x01, 0xfe, 0xff, 0xff, 0x03, 0x04, 0x00, 0x00, 0x00, 0x00, - 0x02, 0xfc, 0xff, 0xfc, 0x01, 0x02, 0x00, 0x00, 0x00, 0x00, 0x04, 0xf0, - 0xff, 0x7c, 0x00, 0x01, 0x00, 0x00, 0x00, 0x00, 0x08, 0xc0, 0xff, 0x1c, - 0x80, 0x00, 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0xff, 0x07, 0x40, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x20, 0x00, 0x00, 0x00, 0x20, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x40, 0x00, 0x00, 0x00, 0x10, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x80, 0x01, 0x00, 0x00, 0x0c, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x06, - 0x00, 0x00, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x18, 0x00, 0xc0, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x01, 0x3c, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0x03, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; diff --git a/lib/gs/contribs/bonk/bitmaps/bonklogo b/lib/gs/contribs/bonk/bitmaps/bonklogo deleted file mode 100644 index 3adc59984a..0000000000 --- a/lib/gs/contribs/bonk/bitmaps/bonklogo +++ /dev/null @@ -1,320 +0,0 @@ -#define bonklogo_width 300 -#define bonklogo_height 100 -static char bonklogo_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xff, 0x3f, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x3c, 0x00, - 0xc0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, - 0x83, 0xff, 0x9f, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x3c, 0xf8, 0xff, 0x7f, 0x06, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x87, 0xff, 0xff, 0xff, 0x08, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x80, 0xf9, 0xff, 0xff, 0xff, 0x13, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, 0xff, 0xff, 0x27, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0xff, 0xff, 0xff, - 0xff, 0x4f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0xff, - 0xff, 0xff, 0xff, 0x9f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x80, 0xff, 0xff, 0xff, 0xff, 0x3f, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x80, 0xff, 0xff, 0xff, 0xff, 0x7f, 0x01, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x80, 0xff, 0xff, 0xff, 0xff, 0x7f, 0x02, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0xff, 0xff, 0xff, 0xff, 0xff, - 0x02, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0xff, 0xff, 0x0f, - 0xfe, 0xff, 0x04, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0xff, - 0xff, 0x2f, 0xf8, 0xff, 0x05, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x80, 0xdf, 0xff, 0x2f, 0xf0, 0xff, 0x0d, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x0f, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x80, 0xc3, 0xff, 0x2f, 0xf0, 0xff, 0x09, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x08, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x80, 0xc0, 0xff, 0x2f, 0xe0, 0xff, 0x0b, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0x01, 0x00, 0x80, 0xff, 0x09, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xff, 0x2f, 0xc0, 0xff, - 0x0b, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x01, 0x00, 0xc0, - 0xff, 0x05, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xff, 0x27, - 0xc0, 0xff, 0x13, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x7f, 0x01, - 0x00, 0xc0, 0xff, 0x04, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, - 0xff, 0x17, 0xc0, 0xff, 0x17, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, - 0x7f, 0x01, 0x00, 0xe0, 0xff, 0x04, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xe0, 0xff, 0x17, 0xc0, 0xff, 0x17, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xfc, 0x7f, 0x01, 0x00, 0xe0, 0xff, 0x02, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xe0, 0xff, 0x17, 0x80, 0xff, 0x17, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xfc, 0x7f, 0xff, 0x3f, 0xe0, 0x7f, 0x02, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xff, 0x17, 0x80, 0xff, 0x17, 0xc0, - 0xff, 0x7f, 0xe0, 0xff, 0x3f, 0xfc, 0x7f, 0x00, 0x20, 0xe0, 0x7f, 0x01, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xff, 0x17, 0x80, 0xff, - 0x17, 0x00, 0x00, 0x80, 0x00, 0x00, 0x20, 0xfc, 0x7f, 0xfe, 0x2f, 0xf0, - 0x3f, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xff, 0x17, - 0x80, 0xff, 0x17, 0xe0, 0xff, 0x1f, 0xe1, 0xff, 0x2f, 0xfc, 0x7f, 0xfe, - 0x2f, 0xf0, 0x3f, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, - 0xff, 0x17, 0x80, 0xff, 0x17, 0xf0, 0xff, 0x7f, 0xe6, 0xff, 0x4f, 0xfc, - 0x7f, 0xfe, 0x2f, 0xf0, 0xbf, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xe0, 0xff, 0x17, 0x80, 0xff, 0x17, 0xf8, 0xff, 0xff, 0xe8, 0xff, - 0x4f, 0xfc, 0x7f, 0xfe, 0x2f, 0xf8, 0x9f, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xe0, 0xff, 0x17, 0x80, 0xff, 0x17, 0xfe, 0xff, 0xff, - 0xeb, 0xff, 0x5f, 0xfc, 0x7f, 0xfe, 0x2f, 0xf8, 0x9f, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xff, 0x17, 0x80, 0xff, 0x17, 0xfe, - 0xff, 0xff, 0xe3, 0xff, 0x5f, 0xfc, 0x7f, 0xfe, 0x2f, 0xf8, 0x5f, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xff, 0x17, 0xc0, 0xff, - 0x17, 0xff, 0xff, 0xff, 0xe7, 0xff, 0x5f, 0xfc, 0x7f, 0xfe, 0x2f, 0xfc, - 0x4f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xff, 0x17, - 0xc0, 0xff, 0x93, 0xff, 0xff, 0xff, 0xe7, 0xff, 0x5f, 0xfc, 0x7f, 0xfe, - 0x2f, 0xfc, 0x4f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, - 0xff, 0x17, 0xc0, 0xff, 0x8b, 0xff, 0xff, 0xff, 0xe7, 0xff, 0x9f, 0xfc, - 0x7f, 0xfe, 0x2f, 0xfc, 0x27, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xe0, 0xff, 0x13, 0xe0, 0xff, 0x8b, 0xff, 0xff, 0xff, 0xcf, 0xff, - 0xbf, 0xfc, 0x7f, 0xfe, 0x2f, 0xfc, 0x27, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xf0, 0xff, 0x0b, 0xf2, 0xff, 0xcd, 0xff, 0xff, 0xff, - 0xcf, 0xff, 0xbf, 0xfc, 0x7f, 0xfe, 0x2f, 0xfe, 0x17, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0x0b, 0xf9, 0xff, 0xd9, 0xff, - 0xff, 0xff, 0x1f, 0xff, 0xbf, 0xfc, 0x7f, 0xfe, 0x2f, 0xfe, 0x13, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xcb, 0xfc, 0xff, - 0xc0, 0xff, 0x8f, 0xff, 0x1f, 0xff, 0xbf, 0xfc, 0x7f, 0xfe, 0x2f, 0xfe, - 0x13, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0x2b, - 0xfe, 0xff, 0x87, 0xff, 0x03, 0xff, 0x3f, 0xff, 0xbf, 0xfc, 0x7f, 0xfe, - 0x2f, 0xff, 0x0b, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, - 0xff, 0x9b, 0xff, 0xff, 0x3f, 0xff, 0x01, 0xfe, 0x3f, 0xff, 0x3f, 0xfd, - 0x7f, 0xfe, 0x2f, 0xff, 0x09, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xf0, 0xff, 0xc3, 0xff, 0xff, 0x7f, 0xfe, 0x05, 0xfc, 0x3f, 0xff, - 0x7f, 0xfd, 0x7f, 0xfe, 0x2f, 0xff, 0x09, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xf0, 0xff, 0xfb, 0xff, 0xff, 0xff, 0xfc, 0x04, 0xfc, - 0x3f, 0xff, 0x7f, 0xfd, 0x7f, 0xfe, 0x2f, 0xff, 0x04, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, 0xff, 0xfc, - 0x02, 0xf8, 0x3f, 0xff, 0x7f, 0xfd, 0x7f, 0xfe, 0xaf, 0xff, 0x04, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, - 0xff, 0xfd, 0x02, 0xf8, 0x3f, 0xff, 0x7f, 0xfc, 0x7f, 0xfe, 0xaf, 0xff, - 0x04, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, - 0xff, 0xff, 0xff, 0xf9, 0x02, 0xf8, 0x3f, 0xff, 0x7f, 0xfc, 0x7f, 0xfe, - 0x8f, 0x7f, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, - 0xff, 0xff, 0xff, 0xff, 0xff, 0xfb, 0x02, 0xf8, 0x3f, 0xff, 0xff, 0xfc, - 0x7f, 0xfe, 0xcf, 0x7f, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, 0xff, 0xf3, 0x02, 0xf8, 0x3f, 0xff, - 0xff, 0xfc, 0x7f, 0xfe, 0xcf, 0x7f, 0x01, 0x00, 0x00, 0x38, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, 0xff, 0xf3, 0x02, 0xf8, - 0x3f, 0xff, 0xff, 0xfc, 0x7f, 0xfe, 0xcf, 0x3f, 0x01, 0x00, 0x00, 0x38, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0xff, 0x3f, 0xfe, 0xff, 0xff, 0xf7, - 0x02, 0xf8, 0x3f, 0xff, 0xff, 0xfc, 0x7f, 0xfe, 0xef, 0x3f, 0x01, 0x00, - 0x00, 0x10, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0xff, 0x03, 0x80, 0xff, - 0xff, 0xe7, 0x02, 0xf8, 0x3f, 0xff, 0xff, 0xfc, 0x7f, 0xfe, 0xef, 0x9f, - 0x00, 0x00, 0x00, 0x00, 0x98, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0xff, 0x01, - 0x00, 0xff, 0xff, 0xe7, 0x02, 0xf8, 0x3f, 0xff, 0xff, 0xfd, 0x7f, 0xfe, - 0xef, 0xdf, 0x00, 0x00, 0x00, 0x30, 0xd8, 0x07, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, - 0xff, 0x05, 0x00, 0xff, 0xff, 0xe7, 0x02, 0xf8, 0x3f, 0xff, 0xff, 0xfd, - 0x7f, 0xfe, 0xef, 0x9f, 0x00, 0x00, 0x00, 0x38, 0xfc, 0x07, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xf8, 0xff, 0x05, 0x00, 0xff, 0xff, 0xef, 0x02, 0xf8, 0x3f, 0xff, - 0xff, 0xfd, 0x7f, 0xfe, 0xff, 0xbf, 0x00, 0x00, 0x00, 0x38, 0x7c, 0x0e, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xf8, 0xff, 0x05, 0x00, 0xfe, 0xff, 0xef, 0x02, 0xf8, - 0x3f, 0xff, 0xff, 0xfd, 0x7f, 0xfe, 0xff, 0x3f, 0x01, 0x00, 0x00, 0x38, - 0x3e, 0x0e, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0xff, 0x05, 0x00, 0xfe, 0xff, 0xef, - 0x02, 0xf8, 0x3f, 0xff, 0xff, 0xfd, 0x7f, 0xfe, 0xff, 0x7f, 0x02, 0x00, - 0x00, 0x38, 0x3e, 0x0e, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0xff, 0x05, 0x00, 0xfc, - 0xff, 0xcf, 0x02, 0xf8, 0x3f, 0xff, 0xff, 0xfd, 0x7f, 0xfe, 0xff, 0xff, - 0x02, 0x00, 0x00, 0x38, 0x3b, 0x0e, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0xff, 0x04, - 0x00, 0xfc, 0xff, 0xcf, 0x02, 0xf8, 0x3f, 0xff, 0xff, 0xff, 0x7f, 0xfe, - 0xff, 0xff, 0x04, 0x00, 0x00, 0xb8, 0x39, 0x2e, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, - 0xff, 0x02, 0x00, 0xfc, 0xff, 0xcf, 0x02, 0xf8, 0x3f, 0xff, 0xff, 0xff, - 0x7f, 0xfe, 0xff, 0xff, 0x05, 0x00, 0x00, 0xf0, 0x39, 0x3c, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xf8, 0xff, 0x02, 0x00, 0xfc, 0xff, 0xcf, 0x04, 0xf8, 0x3f, 0xff, - 0xfd, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x09, 0x00, 0x00, 0xf0, 0x38, 0x1c, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xf8, 0xff, 0x02, 0x00, 0xfc, 0xff, 0xcf, 0x05, 0xf8, - 0x3f, 0xff, 0xfd, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x13, 0x00, 0x00, 0x60, - 0x08, 0x08, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0x02, 0x00, 0xfc, 0xff, 0xcf, - 0x0d, 0xf8, 0x3f, 0xff, 0xfd, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x17, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0x02, 0x00, 0xfe, - 0xff, 0xcf, 0x09, 0xfd, 0x3f, 0xff, 0xfd, 0xff, 0x7f, 0xfe, 0xff, 0xff, - 0x27, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0x02, - 0x00, 0xfe, 0xff, 0xcf, 0xcb, 0xfc, 0x3f, 0xff, 0xfd, 0xff, 0x7f, 0xfe, - 0xff, 0xff, 0x4f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, - 0xff, 0x02, 0x00, 0xfe, 0xff, 0xcf, 0x33, 0xfe, 0x3f, 0xff, 0xf9, 0xff, - 0x7f, 0xfe, 0xff, 0xff, 0x5f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xfc, 0xff, 0x02, 0x00, 0xfe, 0xff, 0xcf, 0x07, 0xff, 0x3f, 0xff, - 0xf9, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x9f, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xfc, 0xff, 0x02, 0x00, 0xfe, 0xff, 0xcf, 0xcf, 0xff, - 0x3f, 0xff, 0xf9, 0xff, 0x7f, 0xfe, 0x7f, 0xff, 0x3f, 0x01, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0x02, 0x40, 0xfe, 0xff, 0xcf, - 0xff, 0xff, 0x3f, 0xff, 0xf9, 0xff, 0x7f, 0xfe, 0x7f, 0xfe, 0x3f, 0x01, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0x02, 0x3c, 0xff, - 0xff, 0xc7, 0xff, 0xff, 0x3f, 0xff, 0xf9, 0xff, 0x7f, 0xfe, 0x7f, 0xfe, - 0x7f, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0x82, - 0x87, 0xff, 0xff, 0xe7, 0xff, 0xff, 0x3f, 0xff, 0xf1, 0xff, 0x7f, 0xfe, - 0x3f, 0xfc, 0xff, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, - 0xff, 0x72, 0xf0, 0xff, 0xff, 0xe7, 0xff, 0xff, 0x3f, 0xff, 0xf1, 0xff, - 0x7f, 0xfe, 0xbf, 0xf8, 0xff, 0x04, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xfc, 0xff, 0x0e, 0xff, 0xff, 0xff, 0xe7, 0xff, 0xff, 0x9f, 0xff, - 0xf5, 0xff, 0x7f, 0xfe, 0xbf, 0xf8, 0xff, 0x09, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xfc, 0xff, 0xe0, 0xff, 0xff, 0xff, 0xe7, 0xff, 0xff, - 0x9f, 0xff, 0xf5, 0xff, 0x7f, 0xfe, 0x9f, 0xf0, 0xff, 0x0b, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0xff, 0xff, 0xff, 0xff, 0xe7, - 0xff, 0xff, 0x9f, 0xff, 0xf5, 0xff, 0x7f, 0xfe, 0x5f, 0xf0, 0xff, 0x13, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xfe, 0xff, 0xff, 0xff, 0xff, - 0xff, 0xf3, 0xff, 0xff, 0xdf, 0xff, 0xf5, 0xff, 0x7f, 0xfe, 0x4f, 0xe0, - 0xff, 0x27, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x30, 0xfe, 0xff, 0xff, - 0xff, 0xff, 0xff, 0xf3, 0xff, 0xff, 0xcf, 0xff, 0xe5, 0xff, 0x7f, 0xfe, - 0x2f, 0xe0, 0xff, 0x27, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0xff, - 0xff, 0xff, 0xff, 0xff, 0xff, 0xf3, 0xff, 0xff, 0xcf, 0xff, 0xe5, 0xff, - 0x7f, 0xfe, 0x2f, 0xc0, 0xff, 0x4f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0xf0, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xf1, 0xff, 0xff, 0xe7, 0xff, - 0xe5, 0xff, 0x7f, 0xfe, 0x2f, 0xc0, 0xff, 0x9f, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, 0xff, 0x7f, 0xf8, 0xff, 0xff, - 0xe7, 0xff, 0xe5, 0xff, 0x7f, 0xfe, 0x2f, 0x80, 0xff, 0x9f, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, 0xff, 0x7f, 0xfc, - 0xff, 0xff, 0xf7, 0xff, 0xe5, 0xff, 0x7f, 0xfe, 0x2f, 0x00, 0xff, 0x3f, - 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, 0xff, - 0x1f, 0xfe, 0xff, 0xff, 0xf3, 0xff, 0xc5, 0xff, 0x7f, 0xfe, 0x2f, 0x00, - 0xff, 0x7f, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0xff, - 0xff, 0xff, 0x0f, 0xff, 0xff, 0xff, 0xf3, 0xff, 0xc5, 0xff, 0x7f, 0xfe, - 0x2f, 0x00, 0xfe, 0x7f, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, - 0xff, 0xff, 0xff, 0xff, 0x23, 0xff, 0xff, 0xff, 0xf1, 0xff, 0xc5, 0xff, - 0x7f, 0xfe, 0x2f, 0x00, 0xfe, 0xff, 0x04, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0xf0, 0xff, 0xff, 0xff, 0xff, 0xff, 0x11, 0xfe, 0xff, 0xff, 0xf5, 0xff, - 0xc5, 0xff, 0x7f, 0xfe, 0x2f, 0x00, 0xfc, 0xff, 0x04, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, 0x7f, 0x0c, 0xfc, 0xff, 0xff, - 0xf4, 0xff, 0xc5, 0xff, 0x7f, 0xfe, 0x2f, 0x00, 0xfc, 0xff, 0x09, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, 0x1f, 0x02, 0xfc, - 0xff, 0x7f, 0xf2, 0xff, 0xc5, 0xff, 0x7f, 0xfe, 0x2f, 0x00, 0xf8, 0xff, - 0x13, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, 0x01, - 0x00, 0xe0, 0xff, 0x3f, 0xf1, 0xff, 0x85, 0xff, 0x7f, 0xfe, 0x2f, 0x00, - 0xf8, 0xff, 0x13, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0xff, - 0x3f, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0x85, 0xff, 0x7f, 0xfe, - 0x2f, 0x00, 0xf0, 0xff, 0x27, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, - 0xff, 0xff, 0x07, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0x85, 0xff, - 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0xf0, 0xff, 0xff, 0x3f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0xf0, 0xff, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x7f, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; diff --git a/lib/gs/contribs/bonk/bitmaps/bonkmiss b/lib/gs/contribs/bonk/bitmaps/bonkmiss deleted file mode 100644 index 862e4839fc..0000000000 --- a/lib/gs/contribs/bonk/bitmaps/bonkmiss +++ /dev/null @@ -1,66 +0,0 @@ -#define bonkmiss_width 75 -#define bonkmiss_height 75 -static char bonkmiss_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x60, 0x80, 0x19, 0x3c, 0xc0, 0x83, 0xff, 0xf9, 0x01, 0x00, 0x60, 0x80, - 0x19, 0x7e, 0xe0, 0x87, 0xff, 0xf9, 0x03, 0x00, 0xe0, 0xc0, 0x19, 0xe7, - 0x70, 0x8e, 0x01, 0x18, 0x07, 0x00, 0xe0, 0xc0, 0x99, 0xc3, 0x39, 0x9c, - 0x01, 0x18, 0x0e, 0x00, 0xe0, 0xe1, 0x99, 0x81, 0x19, 0x98, 0x01, 0x18, - 0x0c, 0x00, 0xe0, 0xe1, 0x99, 0x81, 0x19, 0x98, 0x01, 0x18, 0x1c, 0x00, - 0xe0, 0xf3, 0x99, 0x01, 0x18, 0x80, 0x01, 0x18, 0x18, 0x00, 0x60, 0xb3, - 0x99, 0x01, 0x18, 0x80, 0x01, 0x18, 0x18, 0x00, 0x60, 0xb3, 0x99, 0x03, - 0x38, 0x80, 0x01, 0x18, 0x18, 0x00, 0x60, 0x9e, 0x19, 0x07, 0x70, 0x80, - 0x01, 0x18, 0x18, 0x00, 0x60, 0x9e, 0x19, 0x3e, 0xe0, 0x83, 0x1f, 0x18, - 0x18, 0x00, 0x60, 0x8c, 0x19, 0x7c, 0xc0, 0x87, 0x1f, 0x18, 0x18, 0x00, - 0x60, 0x80, 0x19, 0xe0, 0x00, 0x8e, 0x01, 0x18, 0x18, 0x00, 0x60, 0x80, - 0x19, 0xc0, 0x01, 0x9c, 0x01, 0x18, 0x18, 0x00, 0x60, 0x80, 0x19, 0x80, - 0x01, 0x98, 0x01, 0x18, 0x18, 0x00, 0x60, 0x80, 0x19, 0x80, 0x01, 0x98, - 0x01, 0x18, 0x18, 0x00, 0x60, 0x80, 0x19, 0x80, 0x01, 0x98, 0x01, 0x18, - 0x18, 0x00, 0x60, 0x80, 0x99, 0x81, 0x19, 0x98, 0x01, 0x18, 0x18, 0x00, - 0x60, 0x80, 0x99, 0x81, 0x19, 0x98, 0x01, 0x18, 0x18, 0x00, 0x60, 0x80, - 0x99, 0x81, 0x19, 0x98, 0x01, 0x18, 0x18, 0x00, 0x60, 0x80, 0x99, 0x81, - 0x19, 0x98, 0x01, 0x18, 0x18, 0x00, 0x60, 0x80, 0x99, 0x81, 0x19, 0x98, - 0x01, 0x18, 0x18, 0x00, 0x60, 0x80, 0x99, 0x81, 0x19, 0x98, 0x01, 0x18, - 0x18, 0x00, 0x60, 0x80, 0x99, 0x81, 0x19, 0x98, 0x01, 0x18, 0x1c, 0x00, - 0x60, 0x80, 0x99, 0x81, 0x19, 0x98, 0x01, 0x18, 0x0c, 0x00, 0x60, 0x80, - 0x99, 0xc3, 0x39, 0x9c, 0x01, 0x18, 0x0e, 0x00, 0x60, 0x80, 0x19, 0xe7, - 0x70, 0x8e, 0x01, 0x18, 0x07, 0x00, 0x60, 0x80, 0x19, 0x7e, 0xe0, 0x87, - 0xff, 0xf9, 0x03, 0x00, 0x60, 0x80, 0x19, 0x3c, 0xc0, 0x83, 0xff, 0xf9, - 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x30, 0xff, 0x03, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x30, 0xff, 0x03, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x1c, 0x38, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x1c, 0x38, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x3c, - 0x3c, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x3c, 0x3c, 0x03, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x7c, 0x3e, 0x03, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x6c, 0x36, 0x03, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x6c, 0x36, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xcc, 0x33, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xcc, - 0x33, 0x3f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x8c, 0x31, 0x3f, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x30, 0x03, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x30, 0x03, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x0c, 0x30, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x0c, 0x30, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, - 0x30, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x30, 0x03, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x30, 0x03, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x30, 0x03, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x0c, 0x30, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x0c, 0x30, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, - 0x30, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x30, 0x03, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x30, 0x03, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x30, 0x03, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x0c, 0x30, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x0c, 0x30, 0xff, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, - 0x30, 0xff, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; diff --git a/lib/gs/contribs/bonk/bitmaps/bonktom b/lib/gs/contribs/bonk/bitmaps/bonktom deleted file mode 100644 index defbc32cc9..0000000000 --- a/lib/gs/contribs/bonk/bitmaps/bonktom +++ /dev/null @@ -1,66 +0,0 @@ -#define bonktom_width 75 -#define bonktom_height 75 -static char bonktom_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; diff --git a/lib/gs/contribs/bonk/bitmaps/bonkx b/lib/gs/contribs/bonk/bitmaps/bonkx deleted file mode 100644 index 70cd89bdb7..0000000000 --- a/lib/gs/contribs/bonk/bitmaps/bonkx +++ /dev/null @@ -1,66 +0,0 @@ -#define bonkx_width 75 -#define bonkx_height 75 -static char bonkx_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x1e, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x03, 0x3e, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0xe0, 0x03, 0x7e, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0xf0, 0x03, 0xfe, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0xf8, 0x03, 0xfc, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x01, - 0xf8, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0x00, 0xf0, 0x07, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x7f, 0x00, 0xe0, 0x0f, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x80, 0x3f, 0x00, 0xc0, 0x1f, 0x00, 0x00, 0xfe, 0x03, - 0x00, 0xc0, 0x1f, 0x00, 0x80, 0x3f, 0x00, 0xe0, 0x01, 0x3c, 0x00, 0xe0, - 0x0f, 0x00, 0x00, 0x7f, 0x00, 0x18, 0x00, 0xc0, 0x00, 0xf0, 0x07, 0x00, - 0x00, 0xfe, 0x00, 0x06, 0x00, 0x00, 0x03, 0xf8, 0x03, 0x00, 0x00, 0xfc, - 0x81, 0x01, 0x00, 0x00, 0x0c, 0xfc, 0x01, 0x00, 0x00, 0xf8, 0x43, 0x00, - 0x00, 0x00, 0x10, 0xfe, 0x00, 0x00, 0x00, 0xf0, 0x27, 0x00, 0x00, 0x00, - 0x20, 0x7f, 0x00, 0x00, 0x00, 0xe0, 0x1f, 0x00, 0x00, 0x00, 0xc0, 0x3f, - 0x00, 0x00, 0x00, 0xc0, 0x1f, 0x00, 0x00, 0x00, 0xc0, 0x1f, 0x00, 0x00, - 0x00, 0x80, 0x3f, 0x00, 0x00, 0x00, 0xe0, 0x0f, 0x00, 0x00, 0x00, 0x00, - 0x7f, 0x00, 0x00, 0x00, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00, 0xff, 0x08, - 0x00, 0x80, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00, 0xfd, 0x31, 0x00, 0x60, - 0xfc, 0x05, 0x00, 0x00, 0x00, 0x80, 0xf8, 0xc3, 0x00, 0x18, 0xfe, 0x08, - 0x00, 0x00, 0x00, 0x80, 0xf7, 0x07, 0x03, 0x06, 0x7f, 0x0f, 0x00, 0x00, - 0x00, 0x40, 0xff, 0x0f, 0x00, 0x80, 0xff, 0x17, 0x00, 0x00, 0x00, 0x40, - 0xfe, 0x1f, 0x00, 0xc0, 0xff, 0x13, 0x00, 0x00, 0x00, 0x20, 0xf8, 0xff, - 0x03, 0xfe, 0xff, 0x20, 0x00, 0x00, 0x00, 0x20, 0xf0, 0xff, 0xff, 0xff, - 0x7f, 0x20, 0x00, 0x00, 0x00, 0x20, 0xc0, 0xff, 0xdf, 0xff, 0x1f, 0x20, - 0x00, 0x00, 0x00, 0x20, 0x00, 0xff, 0xdf, 0xff, 0x07, 0x20, 0x00, 0x00, - 0x00, 0x10, 0x00, 0xfe, 0x8f, 0xff, 0x03, 0x40, 0x00, 0x00, 0x00, 0x10, - 0x00, 0xf8, 0x8f, 0xff, 0x00, 0x40, 0x00, 0x00, 0x00, 0x10, 0x00, 0xf0, - 0x8f, 0x7f, 0x00, 0x40, 0x00, 0x00, 0x00, 0x10, 0x00, 0xc0, 0xdf, 0x1f, - 0x00, 0x40, 0x00, 0x00, 0x00, 0x10, 0x00, 0x80, 0xff, 0x0f, 0x00, 0x40, - 0x00, 0x00, 0x00, 0x10, 0x00, 0x00, 0xff, 0x07, 0x00, 0x40, 0x00, 0x00, - 0x00, 0x10, 0x00, 0x00, 0xfe, 0x03, 0x00, 0x40, 0x00, 0x00, 0x00, 0x10, - 0x00, 0x00, 0xfc, 0x01, 0x00, 0x40, 0x00, 0x00, 0x00, 0x10, 0x00, 0xe0, - 0xfe, 0x3b, 0x00, 0x40, 0x00, 0x00, 0x00, 0x10, 0x10, 0xf0, 0xff, 0x7f, - 0x40, 0x40, 0x00, 0x00, 0x00, 0x10, 0x10, 0x80, 0xff, 0x0f, 0x40, 0x40, - 0x00, 0x00, 0x00, 0x10, 0x10, 0xc0, 0xff, 0x1f, 0x40, 0x40, 0x00, 0x00, - 0x00, 0x10, 0x30, 0xe0, 0x8f, 0x3f, 0x60, 0x40, 0x00, 0x00, 0x00, 0x10, - 0x70, 0xf0, 0x07, 0x7f, 0x70, 0x40, 0x00, 0x00, 0x00, 0x10, 0xf0, 0xf9, - 0x03, 0xfe, 0x7c, 0x40, 0x00, 0x00, 0x00, 0x20, 0xf0, 0xff, 0x01, 0xfc, - 0x7f, 0x20, 0x00, 0x00, 0x00, 0x20, 0xf0, 0xff, 0x03, 0xfe, 0x7f, 0x20, - 0x00, 0x00, 0x00, 0x20, 0xf0, 0x7f, 0xfe, 0xff, 0x7f, 0x20, 0x00, 0x00, - 0x00, 0x20, 0xe0, 0x7f, 0xfe, 0xff, 0x3f, 0x20, 0x00, 0x00, 0x00, 0x40, - 0xe0, 0x7f, 0xfe, 0xff, 0x3f, 0x10, 0x00, 0x00, 0x00, 0x40, 0xe0, 0xff, - 0xff, 0xff, 0x3f, 0x10, 0x00, 0x00, 0x00, 0x80, 0xf0, 0xff, 0xff, 0xff, - 0x7f, 0x08, 0x00, 0x00, 0x00, 0x80, 0xf8, 0xff, 0xff, 0xff, 0xff, 0x08, - 0x00, 0x00, 0x00, 0x00, 0xfd, 0xff, 0xff, 0xff, 0xff, 0x05, 0x00, 0x00, - 0x00, 0x00, 0xff, 0xfe, 0xff, 0xff, 0xfb, 0x07, 0x00, 0x00, 0x00, 0x00, - 0x7f, 0xfc, 0xff, 0xfc, 0xf1, 0x07, 0x00, 0x00, 0x00, 0x80, 0x3f, 0xf0, - 0xff, 0x7c, 0xe0, 0x0f, 0x00, 0x00, 0x00, 0xc0, 0x1f, 0xc0, 0xff, 0x1c, - 0xc0, 0x1f, 0x00, 0x00, 0x00, 0xe0, 0x1f, 0x00, 0xff, 0x07, 0xc0, 0x3f, - 0x00, 0x00, 0x00, 0xf0, 0x27, 0x00, 0x00, 0x00, 0x20, 0x7f, 0x00, 0x00, - 0x00, 0xf8, 0x43, 0x00, 0x00, 0x00, 0x10, 0xfe, 0x00, 0x00, 0x00, 0xfc, - 0x81, 0x01, 0x00, 0x00, 0x0c, 0xfc, 0x01, 0x00, 0x00, 0xfe, 0x00, 0x06, - 0x00, 0x00, 0x03, 0xf8, 0x03, 0x00, 0x00, 0x7f, 0x00, 0x18, 0x00, 0xc0, - 0x00, 0xf0, 0x07, 0x00, 0x80, 0x3f, 0x00, 0xe0, 0x01, 0x3c, 0x00, 0xe0, - 0x0f, 0x00, 0xc0, 0x1f, 0x00, 0x00, 0xfe, 0x03, 0x00, 0xc0, 0x1f, 0x00, - 0xe0, 0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x3f, 0x00, 0xf0, 0x07, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x7f, 0x00, 0xf8, 0x03, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0xfe, 0x00, 0xfc, 0x01, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0xfc, 0x01, 0xfc, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0xf8, 0x03, 0x7e, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x03, - 0x3e, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x03, 0x1e, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x03, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; diff --git a/lib/gs/contribs/bonk/bitmaps/erl-e b/lib/gs/contribs/bonk/bitmaps/erl-e deleted file mode 100644 index 41ad14f404..0000000000 --- a/lib/gs/contribs/bonk/bitmaps/erl-e +++ /dev/null @@ -1,106 +0,0 @@ -#define erl-e_width 108 -#define erl-e_height 88 -static char erl-e_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xf0, 0xfc, 0xff, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xe0, 0xff, 0xf7, 0xfc, 0xff, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xff, 0xf7, 0xfc, 0x7f, 0x00, 0x00, - 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0x00, 0x80, 0xff, 0xf7, 0xfc, 0x3f, - 0x00, 0x00, 0x00, 0x00, 0xfc, 0x3f, 0x00, 0x00, 0x00, 0x00, 0xff, 0xf7, - 0xfc, 0x3f, 0x00, 0x00, 0x00, 0x00, 0xff, 0x7f, 0x00, 0x00, 0x00, 0x00, - 0xff, 0xf7, 0xfc, 0x1f, 0x00, 0x00, 0x00, 0x80, 0xff, 0xff, 0x00, 0x00, - 0x00, 0x00, 0xfe, 0xf7, 0xfc, 0x1f, 0x00, 0x00, 0x00, 0xc0, 0xff, 0xff, - 0x01, 0x00, 0x00, 0x00, 0xfe, 0xf7, 0xfc, 0x0f, 0x00, 0x00, 0x00, 0xe0, - 0xff, 0xff, 0x03, 0x00, 0x00, 0x00, 0xfc, 0xf7, 0xfc, 0x0f, 0x00, 0x00, - 0x00, 0xf0, 0xff, 0xff, 0x07, 0x00, 0x00, 0x00, 0xfc, 0xf7, 0xfc, 0x07, - 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x07, 0x00, 0x00, 0x00, 0xf8, 0xf7, - 0xfc, 0x07, 0x00, 0x00, 0x00, 0xf8, 0xff, 0xff, 0x0f, 0x00, 0x00, 0x00, - 0xf8, 0xf7, 0xfc, 0x03, 0x00, 0x00, 0x00, 0xf8, 0xff, 0xff, 0x0f, 0x00, - 0x00, 0x00, 0xf8, 0xf7, 0xfc, 0x03, 0x00, 0x00, 0x00, 0xf8, 0xff, 0xff, - 0x0f, 0x00, 0x00, 0x00, 0xf0, 0xf7, 0xfc, 0x01, 0x00, 0x00, 0x00, 0xfc, - 0xff, 0xff, 0x1f, 0x00, 0x00, 0x00, 0xf0, 0xf7, 0xfc, 0x01, 0x00, 0x00, - 0x00, 0xfc, 0xff, 0xff, 0x1f, 0x00, 0x00, 0x00, 0xf0, 0xf7, 0xfc, 0x00, - 0x00, 0x00, 0x00, 0xfc, 0xff, 0xff, 0x1f, 0x00, 0x00, 0x00, 0xf0, 0xf7, - 0xfc, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0xf0, 0xf7, 0xfc, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0xe0, 0xf7, 0xfc, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0xe0, 0xf7, 0x7c, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xf7, 0x7c, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xf7, 0x7c, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xf7, - 0x7c, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0xe0, 0xf7, 0x3c, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0xe0, 0xf7, 0x3c, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0xe0, 0xf7, 0x3c, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xf7, 0x3c, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xf7, 0x3c, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xf7, - 0x3c, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0xe0, 0xf7, 0x3c, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0xc0, 0xf7, 0x3c, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0xc0, 0xf7, 0x3c, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xf7, 0x3c, 0x00, 0x00, 0x00, - 0x00, 0xfe, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xf7, 0x3c, 0x00, - 0x00, 0x00, 0x00, 0xfe, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xf7, - 0x3c, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, - 0xff, 0xf7, 0x3c, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, 0xff, 0xff, 0xff, - 0xff, 0xff, 0xff, 0xf7, 0x3c, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, 0xff, - 0xff, 0xff, 0xff, 0xff, 0xff, 0xf7, 0x3c, 0x00, 0x00, 0x00, 0x00, 0xfe, - 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xf7, 0x3c, 0x00, 0x00, 0x00, - 0x00, 0xfe, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xf7, 0x3c, 0x00, - 0x00, 0x00, 0x00, 0xfe, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xf7, - 0x3c, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, - 0xff, 0xf7, 0x3c, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, 0xff, 0xff, 0xff, - 0xff, 0xff, 0xff, 0xf7, 0x3c, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, 0xff, - 0xff, 0xff, 0xff, 0xff, 0xff, 0xf7, 0x3c, 0x00, 0x00, 0x00, 0x00, 0xfe, - 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xf7, 0x7c, 0x00, 0x00, 0x00, - 0x00, 0xfc, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xf7, 0x7c, 0x00, - 0x00, 0x00, 0x00, 0xfc, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xf7, - 0x7c, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, - 0xff, 0xf7, 0x7c, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0xff, 0xff, 0xff, - 0x7f, 0xfe, 0xff, 0xf7, 0xfc, 0x00, 0x00, 0x00, 0x00, 0xf8, 0xff, 0xff, - 0xff, 0xff, 0x3f, 0xf8, 0xff, 0xf7, 0xfc, 0x00, 0x00, 0x00, 0x00, 0xf8, - 0xff, 0xff, 0xff, 0xff, 0x3f, 0xe0, 0xff, 0xf7, 0xfc, 0x00, 0x00, 0x00, - 0x00, 0xf8, 0xff, 0xff, 0xff, 0xff, 0x1f, 0xc0, 0xff, 0xf7, 0xfc, 0x01, - 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x00, 0xfe, 0xf7, - 0xfc, 0x01, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x00, - 0xf8, 0xf7, 0xfc, 0x01, 0x00, 0x00, 0x00, 0xe0, 0xff, 0xff, 0xff, 0xff, - 0x03, 0x00, 0xe0, 0xf7, 0xfc, 0x03, 0x00, 0x00, 0x00, 0xe0, 0xff, 0xff, - 0xff, 0xff, 0x03, 0x00, 0xc0, 0xf7, 0xfc, 0x03, 0x00, 0x00, 0x00, 0xc0, - 0xff, 0xff, 0xff, 0xff, 0x01, 0x00, 0x80, 0xf7, 0xfc, 0x07, 0x00, 0x00, - 0x00, 0x80, 0xff, 0xff, 0xff, 0xff, 0x00, 0x00, 0x80, 0xf7, 0xfc, 0x07, - 0x00, 0x00, 0x00, 0x00, 0xff, 0xff, 0xff, 0x7f, 0x00, 0x00, 0x80, 0xf7, - 0xfc, 0x0f, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, 0xff, 0x1f, 0x00, 0x00, - 0xc0, 0xf7, 0xfc, 0x0f, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0xff, 0x0f, - 0x00, 0x00, 0xe0, 0xf7, 0xfc, 0x1f, 0x00, 0x00, 0x00, 0x00, 0xf8, 0xff, - 0xff, 0x07, 0x00, 0x00, 0xe0, 0xf7, 0xfc, 0x1f, 0x00, 0x00, 0x00, 0x00, - 0xf0, 0xff, 0xff, 0x03, 0x00, 0x00, 0xf0, 0xf7, 0xfc, 0x3f, 0x00, 0x00, - 0x00, 0x00, 0x80, 0xff, 0x7f, 0x00, 0x00, 0x00, 0xf8, 0xf7, 0xfc, 0x7f, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0x1f, 0x00, 0x00, 0x00, 0xfc, 0xf7, - 0xfc, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0xfc, 0xf7, 0xfc, 0xff, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0xfe, 0xf7, 0xfc, 0xff, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0xff, 0xf7, 0xfc, 0xff, 0x03, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0xff, 0xf7, 0xfc, 0xff, 0x07, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xff, 0xf7, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0}; diff --git a/lib/gs/contribs/bonk/bitmaps/erl-text b/lib/gs/contribs/bonk/bitmaps/erl-text deleted file mode 100644 index e20a9e5a28..0000000000 --- a/lib/gs/contribs/bonk/bitmaps/erl-text +++ /dev/null @@ -1,106 +0,0 @@ -#define erl-text_width 108 -#define erl-text_height 88 -static char erl-text_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, - 0xfc, 0x03, 0xf8, 0x00, 0x70, 0x00, 0x80, 0x03, 0x80, 0x03, 0x07, 0x00, - 0x3e, 0xf0, 0xfc, 0x03, 0xf8, 0x03, 0x70, 0x00, 0x80, 0x03, 0x80, 0x07, - 0x07, 0x80, 0xff, 0xf0, 0xfc, 0x03, 0xf8, 0x07, 0x70, 0x00, 0xc0, 0x07, - 0x80, 0x07, 0x07, 0xe0, 0xff, 0xf1, 0x1c, 0x00, 0x38, 0x07, 0x70, 0x00, - 0xc0, 0x07, 0x80, 0x0f, 0x07, 0xe0, 0xc1, 0xf3, 0x1c, 0x00, 0x38, 0x0e, - 0x70, 0x00, 0xe0, 0x0f, 0x80, 0x1f, 0x07, 0xf0, 0x80, 0xf3, 0x1c, 0x00, - 0x38, 0x0f, 0x70, 0x00, 0xe0, 0x0e, 0x80, 0x1f, 0x07, 0x78, 0x00, 0xf0, - 0xfc, 0x03, 0xf8, 0x07, 0x70, 0x00, 0xe0, 0x0e, 0x80, 0x3f, 0x07, 0x78, - 0x00, 0xf0, 0xfc, 0x03, 0xf8, 0x03, 0x70, 0x00, 0x70, 0x1c, 0x80, 0x7b, - 0x07, 0x38, 0x00, 0xf0, 0xfc, 0x03, 0xf8, 0x01, 0x70, 0x00, 0x70, 0x1c, - 0x80, 0xf3, 0x07, 0x38, 0xf8, 0xf7, 0x1c, 0x00, 0xf8, 0x01, 0x70, 0x00, - 0x70, 0x1c, 0x80, 0xe3, 0x07, 0x78, 0xf8, 0xf7, 0x1c, 0x00, 0xf8, 0x03, - 0x70, 0x00, 0xf8, 0x3f, 0x80, 0xe3, 0x07, 0x70, 0x80, 0xf7, 0x1c, 0x00, - 0xb8, 0x03, 0x70, 0x00, 0xf8, 0x3f, 0x80, 0xc3, 0x07, 0xf0, 0x80, 0xf3, - 0xfc, 0x03, 0x38, 0x07, 0xf0, 0x07, 0x38, 0x38, 0x80, 0x83, 0x07, 0xe0, - 0xe3, 0xf3, 0xfc, 0x03, 0x38, 0x07, 0xf0, 0x07, 0x1c, 0x70, 0x80, 0x83, - 0x07, 0xc0, 0xff, 0xf1, 0xfc, 0x03, 0x38, 0x0e, 0xf0, 0x07, 0x1c, 0x70, - 0x80, 0x03, 0x07, 0x00, 0x7f, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0}; diff --git a/lib/gs/contribs/bonk/bonk.erl b/lib/gs/contribs/bonk/bonk.erl deleted file mode 100644 index bbbc656b34..0000000000 --- a/lib/gs/contribs/bonk/bonk.erl +++ /dev/null @@ -1,584 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2012. 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(bonk). --compile([{nowarn_deprecated_function,{gs,config,2}}, - {nowarn_deprecated_function,{gs,create,3}}, - {nowarn_deprecated_function,{gs,create,4}}, - {nowarn_deprecated_function,{gs,destroy,1}}, - {nowarn_deprecated_function,{gs,start,0}}]). - --export([run/0, run/1,bonk_dir/0,start/0]). - --record(colors, {miss, x, bomb, face}). --record(scores, {points, level, bombs, hits, showed, bonus}). - -start() -> - spawn(bonk, run, []). - -run() -> - run(color). - -run([ColorMode]) -> % This is for the start script... - run(ColorMode); - -run(ColorMode) when is_atom(ColorMode) -> - GS = gs:start(), - SoundPid = spawn_link(bonk_sound,start,[]), - {H,M,S} = time(), - random:seed(H*13,M*7,S*3), - {SqrPids, Bmps, Colors} = create_board(GS, ColorMode), - {ScoreL,_File} = get_highscore(), - display_highscore(ScoreL), - put(colormode, ColorMode), - SoundPid ! music, - sleep(6500), - gs:config(aboutButton, [{enable,true}]), - gs:config(newButton, [{enable,true}]), - gs:config(quitButton, [{enable,true}]), - idle(SoundPid, SqrPids, Bmps, Colors). - -%% This is not an application so we don't have their way of knowing -%% a private data directory where the GIF files are located (this directory). -%% We can find GS and makes it relative from there /kgb -%% -%% Note the silly slash that is added. The rest of the code uses -%% append to contruct file names and assumes that the directory ends -%% in slash. If filename:join was used and the problem is gone. - --define(EbinFromGsPriv,"../contribs/bonk"). - -bonk_dir() -> - GsPrivDir = code:priv_dir(gs), - filename:join(GsPrivDir,?EbinFromGsPriv) ++ "/". - - -idle(SoundPid, SqrPids, Bmps, Colors) -> - receive - {gs, newButton, click, _Data, _Args} -> - init(SoundPid, SqrPids, Bmps, Colors); - {gs, aboutButton, click, _Data, _Args} -> - display_about(), - idle(SoundPid, SqrPids, Bmps, Colors); - {gs, quitButton, click, _Data, _Args} -> - SoundPid ! quit, - send_to_all(SqrPids, quit); - _Other -> - %%io:format("Got ~w in idle~n", [_Other]), - idle(SoundPid, SqrPids, Bmps, Colors) - end. - - - -init(SoundPid, SqrPids, Bmps, Colors) -> - clear_board(Bmps), - SoundPid ! start, - gs:config(newButton, [{enable,false}]), - gs:config(endButton, [{enable,true}]), - gs:config(aboutButton, [{enable,false}]), - Scores = #scores{points=0, level=1, bombs=0, hits=0, showed=0, bonus=10}, - clear_scores(Scores), - flush(), - send_to_all(SqrPids, start), - game(SoundPid, SqrPids, Bmps, Colors, Scores). - - -game(SoundPid, SqrPids, Bmps, Colors, Scores) -> - receive - {gs, _Square, buttonpress, SqrPid, [1 | _Rest]} when is_pid(SqrPid) -> - SqrPid ! bonk, - game(SoundPid, SqrPids, Bmps, Colors, Scores); - {gs, _Id, buttonpress, _Data, [Butt | _Rest]} when Butt =/= 1 -> - NewScores = bomb(SoundPid, SqrPids, Scores), - game(SoundPid, SqrPids, Bmps, Colors, NewScores); - {show, Square, Rect} -> - NewScores = show_face(Square, Rect, Colors, Scores), - game(SoundPid, SqrPids, Bmps, Colors, NewScores); - {hide, Square, Rect} -> - NewScores = hide_face(Square, Rect, Colors, Scores), - game(SoundPid, SqrPids, Bmps, Colors, NewScores); - {missed, Square, Rect} -> - case miss_face(SoundPid, Square, Rect, Colors, Scores) of - {continue, NewScores} -> - game(SoundPid, SqrPids, Bmps, Colors, NewScores); - {game_over, NewScores} -> - game_over(SoundPid, SqrPids, Bmps, Colors, NewScores) - end; - {bonked, Square, Rect} -> - NewScores = bonked(SoundPid, SqrPids, Square, Rect, Scores, Colors), - game(SoundPid, SqrPids, Bmps, Colors, NewScores); - {bombed, Square, Rect} -> - NewScores = bombed(SoundPid, SqrPids, Square, Rect, Scores, Colors), - game(SoundPid, SqrPids, Bmps, Colors, NewScores); - {gs, endButton, click, _Data, _Args} -> - game_over(SoundPid, SqrPids, Bmps, Colors, Scores); - {gs, quitButton, click, _Data, _Args} -> - quit(SoundPid, SqrPids, Bmps, Colors, Scores); - _Other -> - game(SoundPid, SqrPids, Bmps, Colors, Scores) - end. - - - -game_over(SoundPid, SqrPids, Bmps, Colors, Scores) -> - SoundPid ! game_over, - send_to_all(SqrPids, stop), - flush(), - sleep(2000), - update_scorelist(SoundPid, Scores), - gs:config(newButton, [{enable,true}]), - gs:config(endButton, [{enable,false}]), - gs:config(aboutButton, [{enable,true}]), - idle(SoundPid, SqrPids, Bmps, Colors). - - -quit(SoundPid, SqrPids, _Bmps, _Colors, _Scores) -> - SoundPid ! quit, - send_to_all(SqrPids, quit), - true. - - - -bomb(SoundPid, SqrPids, Scores) -> - case Scores#scores.bombs of - Bombs when Bombs > 0 -> - send_to_all(SqrPids, bomb), - SoundPid ! bomb, - gs:config(bombOut,[{text,integer_to_list(Bombs-1)}]), - Scores#scores{bombs=Bombs-1}; - _Other -> - Scores - end. - -show_face(Square, Rect, Colors, Scores) -> - Showed = Scores#scores.showed, - if - Showed == Scores#scores.level+1 -> - Square ! sleep, - Scores; - true -> - FaceColors = Colors#colors.face, - FaceColor = lists:nth(random:uniform(length(FaceColors)), FaceColors), - gs:config(Rect, [{bitmap,lists:append(bonk_dir(),"bitmaps/bonkface")},{fg, FaceColor}]), - Scores#scores{showed=Showed+1} - end. - -hide_face(_Square, Rect, _Colors, Scores) -> - Showed = Scores#scores.showed, - gs:config(Rect, [{bitmap,lists:append(bonk_dir(),"bitmaps/bonktom")}]), - Scores#scores{showed=Showed-1}. - - -miss_face(SoundPid, _Square, Rect, Colors, Scores) -> - SoundPid ! missed, - gs:config(Rect, [{bitmap,lists:append(bonk_dir(),"bitmaps/bonkmiss")}, {fg, Colors#colors.miss}]), - Bonus = Scores#scores.bonus, - if - Bonus > 1 -> - gs:config(bonusOut, [{text,integer_to_list(Bonus-1)}]), - {continue, Scores#scores{bonus=Bonus-1}}; - true -> - gs:config(bonusOut, [{text,"0"}]), - {game_over, Scores} - end. - -bonked(SoundPid, SqrPids, _Square, Rect, Scores, Colors) -> - gs:config(Rect, [{bitmap,lists:append(bonk_dir(),"bitmaps/bonkx")}, {fg, Colors#colors.x}]), - SoundPid ! bonk, - update_score(SoundPid, SqrPids, Scores). - -bombed(SoundPid, SqrPids, _Square, Rect, Scores, Colors) -> - gs:config(Rect, [{bitmap,lists:append(bonk_dir(),"bitmaps/bonkbomb")}, {fg, Colors#colors.bomb}]), - update_score(SoundPid, SqrPids, Scores). - - -update_score(SoundPid, SqrPids, Scores) -> - Points = Scores#scores.points, - Level = Scores#scores.level, - NewPoints = Points+Level, - gs:config(scoreOut,[{text,integer_to_list(NewPoints)}]), - case Scores#scores.hits of - 24 -> - SoundPid ! new_level, - NewLevel = Level+1, - NewBombs = Scores#scores.bombs+1, - send_to_all(SqrPids, {new_level, NewLevel}), - gs:config(levelOut,[{text,integer_to_list(NewLevel)}]), - gs:config(bombOut,[{text,integer_to_list(NewBombs)}]), - Scores#scores{points=NewPoints, level=NewLevel, hits=0, bombs=NewBombs}; - Hits -> - Scores#scores{points=NewPoints, hits=Hits+1} - end. - - -send_to_all([], _Msg) -> - true; -send_to_all([Pid|Rest],Msg) when is_pid(Pid) -> - Pid ! Msg, - send_to_all(Rest,Msg); -send_to_all([_Else|Rest],Msg) -> - send_to_all(Rest,Msg). - - -create_board(GS, ColorMode) -> - Colors = - case ColorMode of - bw -> #colors{miss=white, x=white, bomb=white, face=[white]}; - _Color -> #colors{miss=red, x=green, bomb=white, - face=[lightblue, orange, magenta, peachpuff, pink]} - end, - BGCol = if ColorMode==bw -> black; true -> black end, % background color - TextCol = if ColorMode==bw -> white; true -> pink end, % status texts - NrCol = if ColorMode==bw -> white; true -> purple end, % status figures - LogoCol = if ColorMode==bw -> white; true -> green end, % bonk logo - BLineCol = if ColorMode==bw -> white; true -> grey end, % button line - SLineCol = if ColorMode==bw -> white; true -> red end, % status line - BTextCol = if ColorMode==bw -> white; true -> orange end, % button text - HiHeadCol = if ColorMode==bw -> white; true -> red end, % high score label - HiCol = if ColorMode==bw -> white; true -> cyan end, % high scores - SquareCol = if ColorMode==bw -> white; true -> yellow end, % game squares - ErlFgCol = if ColorMode==bw -> white; true -> red end, % - ErlBGCol = if ColorMode==bw -> black; true -> white end, % - ErlTxtCol = if ColorMode==bw -> white; true -> black end, % - - Width = 550, % width of bonk window - Height = 550, % Height of bonk window - - BX = 0, % x-pos for first button - DBX = 100, % space between buttons - BY = 0, % y-pos for buttons - BLineY = 30, % y-pos of button line - LogoX = (Width-320) div 2, % x-pos of bonk logo (logo is 320 pix wide) - LogoY = BLineY+2, % y-pos of bonk logo - ErlLogoX = LogoX + 200, % x-pos of Erlang e - ErlLogoY = LogoY + 10, % y-pos of Erlang e - SLineY = Height-22, % status line position - TextWidth = 50, % text width of status items - SX = 2, % x-pos for first status item - DSX = TextWidth+94, % pixels between status items - SY = SLineY+2, % y-pos status items - HiWidth = 100, % width of high score field - _HiHeight = 180, % height of the same - HiX = Width-HiWidth, % high score text position - HiY = BLineY+10, - DHY = 20, % space between title & scores - SquareSize = 76, % size of each game square - SquareSpace = 1, % space between game squares - SquareX = 40, - SquareY = 65, - - gs:create(window, bonkWin, GS, [{width, Width}, {height, Height}, - {bg, BGCol}, - {title, "Bonk the game"}, - {iconname, "Bonk!"}, - {map, false}]), - gs:create(canvas, bonkCanvas, bonkWin, [{width, Width}, - {height, Height}, - {bg, BGCol}]), - gs:create(image, bonkCanvas, [{bitmap,lists:append(bonk_dir(), "bitmaps/bonklogo")}, - {coords, [{LogoX, LogoY}]}, - {fg, LogoCol}, - {bg, BGCol}]), - gs:create(image, bonkCanvas, [{bitmap,lists:append(bonk_dir(), "bitmaps/erl-e")}, - {coords, [{ErlLogoX, ErlLogoY}]}, - {fg, ErlFgCol}, - {bg, ErlBGCol}]), - gs:create(image, bonkCanvas, [{bitmap,lists:append(bonk_dir(), "bitmaps/erl-text")}, - {coords, [{ErlLogoX, ErlLogoY}]}, - {fg, ErlTxtCol}]), - gs:create(line, bLine, bonkCanvas, [{coords, [{0,BLineY}, {Width,BLineY}]}, - {fg, BLineCol}, - {width, 2}]), - gs:create(line, bLine, bonkCanvas, [{coords, [{0,SLineY}, {Width, SLineY}]}, - {fg, SLineCol}, - {width, 2}]), - gs:create(text, scoreText, bonkCanvas, [{coords, [{SX, SY}]}, - {fg, TextCol}, - {text, "Score:"}]), - gs:create(text, scoreOut, bonkCanvas, [{coords, [{SX+TextWidth, SY}]}, - {fg, NrCol}, - {width, DSX-TextWidth}, - {text, ""}]), - gs:create(text, bombText, bonkCanvas, [{coords, [{SX+DSX, SY}]}, - {fg, TextCol}, - {text, "Bombs:"}]), - gs:create(text, bombOut, bonkCanvas, [{coords, [{SX+DSX+TextWidth, SY}]}, - {fg, NrCol}, - {width, DSX-TextWidth}, - {text, ""}]), - gs:create(text, bonusText, bonkCanvas, [{coords, [{SX+2*DSX, SY}]}, - {fg, TextCol}, - {text, "Bonus:"}]), - gs:create(text, bonusOut, bonkCanvas, [{coords, [{SX+2*DSX+TextWidth, SY}]}, - {fg, NrCol}, - {width, DSX-TextWidth}, - {text, ""}]), - gs:create(text, levelText,bonkCanvas, [{coords, [{SX+3*DSX, SY}]}, - {fg, TextCol}, - {text, "Level:"}]), - gs:create(text, levelOut, bonkCanvas, [{coords, [{SX+3*DSX+TextWidth, SY}]}, - {fg, NrCol}, - {width, DSX-TextWidth}, - {text, ""}]), - gs:create(text, hiScoreText, bonkCanvas, [{coords, [{HiX, HiY}]}, - {fg, HiHeadCol}, - {text, "High Scores"}]), - gs:create(text, hiScoreOut, bonkCanvas, [{coords, [{HiX, HiY+DHY}]}, - {fg, HiCol}, - {justify, left}, - {width, HiWidth}]), - gs:create(button, newButton,bonkWin, [{x, BX},{y, BY}, - {enable,false}, - {label, {text, "New Game"}}, - {click, true}, - {fg, BTextCol}, - {bg, BGCol}, - {relief, flat}, - {activefg, BTextCol}, - {activebg, BGCol}, - {align, center}]), - gs:create(button, endButton,bonkWin, [{x, BX+DBX},{y, BY}, - {enable,false}, - {label, {text, "End Game"}}, - {click, true}, - {fg, BTextCol}, - {bg, BGCol}, - {relief, flat}, - {activefg, BTextCol}, - {activebg, BGCol}, - {align, center}]), - gs:create(button, aboutButton,bonkWin, [{x, BX+2*DBX},{y, BY}, - {enable,false}, - {label, {text, "About"}}, - {click, true}, - {fg, BTextCol}, - {bg, BGCol}, - {relief, flat}, - {activefg, BTextCol}, - {activebg, BGCol}, - {align, center}]), - gs:create(button, quitButton, bonkWin, [{x, BX+3*DBX},{y, BY}, - {enable,false}, - {label, {text, "Quit"}}, - {click, true}, - {fg, BTextCol}, - {bg, BGCol}, - {relief, flat}, - {activefg, BTextCol}, - {activebg, BGCol}, - {align, center}]), - - {SqrPids, Bmps} = - create_squares(SquareX, SquareY, SquareSize, SquareCol, SquareSpace), - gs:config(bonkWin, [{map, true}]), - {SqrPids, Bmps, Colors}. - - - -create_squares(X, Y, Size, Color, Spc) -> - create_squares(X, Y, Size, Color, Spc, 1, 1, [], []). - - -create_squares(_X, _Y, _Size, _Color, _Spc, 4, 5, Pids, Bmps) -> - {Pids, Bmps}; - -create_squares(X, Y, Size, Color, Spc, Row, 5, Pids, Bmps) -> - create_squares(X, Y, Size, Color, Spc, Row+1, 1, Pids, Bmps); - -create_squares(X, Y, Size, Color, Spc, Row, Col, Pids, Bmps) -> - Xpos = X+Col*Size+(Col-1)*Spc, - Ypos = Y+Row*Size+(Row-1)*Spc, - gs:create(rectangle, bonkCanvas, - [{coords, [{Xpos,Ypos},{Xpos+Size, Ypos+Size}]}, - {bw, 2},{fg, Color},{buttonpress,true}]), - Bmp = gs:create(image, bonkCanvas, - [{coords, [{Xpos+1, Ypos+1}]}, - {bitmap,lists:append(bonk_dir(), "bitmaps/bonktom")}, - {buttonpress, true},{fg, Color}]), - Pid = bonk_square:start(Bmp), - gs:config(Bmp, [{data, Pid}]), - create_squares(X, Y, Size, Color, Spc, Row, Col+1, [Pid|Pids], [Bmp|Bmps]). - - - -clear_board([]) -> - true; -clear_board([Square | Rest]) -> - gs:config(Square, [{bitmap,lists:append(bonk_dir(), "bitmaps/bonktom")}]), - clear_board(Rest). - - -%% Prints the list on the screen. -%% The list is on the form [[Score,Name],[Score,Name]..]. - -display_highscore(ScoreList) -> - display_highscore("",ScoreList,0). - -display_highscore(Scores,[],_N) -> - gs:config(hiScoreOut,[{text,Scores}]); - -display_highscore(Scores,_ScoreList,10) -> % This is max number of items. - display_highscore(Scores,[], 10); - -display_highscore(Scores,[[Score,Name]|Rest],N) -> - NewScores = lists:append(Scores,lists:append(lists:append(Score, [32 | Name]), [10])), - display_highscore(NewScores,Rest,N+1). - - -%% Reads the highscorelist from the file "bonk.score". -%% The list should be an sorted erlang-list. - -get_highscore() -> - case file:consult("bonk.score") of - {ok,[Score_list]} -> - {Score_list,"./bonk.score"}; - {error,_} -> - {[],"./bonk.score"} - end. - - -%% Prints out the highscorelist and places the new score in the -%% list if it is high enough. - -update_scorelist(SoundPid, Scores) -> - case Scores#scores.points of - 0 -> true; - Score -> - {ScoreL,FileName} = get_highscore(), - New_scorelist=update_scorelist_2(ScoreL, Score, 0, SoundPid), - display_highscore(New_scorelist), - case file:open(FileName, [write]) of - {error,_} -> - true; - {ok,FD} -> - io:format(FD,"~w~s~n",[New_scorelist,"."]), - file:close(FD) - end - end. - - -update_scorelist_2([], Score, N, _SoundPid) when N < 10 -> - [[integer_to_list(Score),getuser()]]; - -update_scorelist_2(_, _, N, _SoundPid) when N >= 10 -> - []; - -update_scorelist_2([[Sc, Name] | Rest], Score, N, SoundPid) -> - case list_to_integer(Sc) of - Sc_int when Sc_int < Score -> - if - N == 0 -> SoundPid ! best_score; - true -> SoundPid ! high_score - end, - lists:append([[integer_to_list(Score),getuser()]], - update_scorelist_3([[Sc,Name]|Rest],N+1)); - _Other -> - lists:append([[Sc,Name]],update_scorelist_2(Rest, Score, N+1, SoundPid)) - end. - - -update_scorelist_3([],_) -> - []; - -update_scorelist_3(_,N) when N >= 10 -> - []; - -update_scorelist_3([Item|Rest],N) -> - lists:append([Item],update_scorelist_3(Rest,N+1)). - -getuser() -> - case os:type() of - {unix,_} -> - lists:delete(10,os:cmd("whoami")); - _ -> - "Unknown" - end. - -%% Prints out the initial values of scores, bonus, level and bombs. - -clear_scores(Scores) -> - Score = integer_to_list(Scores#scores.points), - Bombs = integer_to_list(Scores#scores.bombs), - Bonus = integer_to_list(Scores#scores.bonus), - Level = integer_to_list(Scores#scores.level), - gs:config(scoreOut,{text,Score}), - gs:config(bombOut,{text,Bombs}), - gs:config(bonusOut,{text,Bonus}), - gs:config(levelOut,{text,Level}). - - -%% Removes everything that is present in the message-que. - -flush() -> - receive - _X -> - flush() - after - 0 -> - true - end. - -sleep(X) -> - receive after X -> true end. - -%% Opens a window and shows the contents of the file: "bonk.txt". -%% The window will be removed before the function ends. - -display_about() -> - {BGColor,TextColor,Bfg} = - case get(colormode) of - bw -> {black, white, white}; - _Color -> {black, peachpuff1, orange} - end, - Wid = 500, Hei = 635, - GS = gs:start(), - gs:create(window, aboutWin, GS, [{width, Wid}, {height,Hei}, - {map, false}, - {bg, BGColor}, - {title, "About Bonk!"}]), - gs:create(canvas, aboutCan, aboutWin, [{width, Wid},{height, Hei}, - {bg, black}]), - gs:create(button, okButton, aboutWin, [{x, Wid div 2 - 50},{y, Hei - 40}, - {label,{text, "Ok"}}, {click, true}, - {fg, Bfg}, {bg, BGColor}, - {relief, flat}, - {activefg, Bfg}, - {activebg, BGColor}]), - gs:create(text, aboutText, aboutCan, [{width, Wid-30}, {coords, [{15, 0}]}, - {fg, TextColor}, {justify, center}]), - case file:open(lists:append(bonk_dir(),"bonk.txt"), [read]) of - {ok, Fd} -> - write_text(Fd, "", io:get_line(Fd, "")), - file:close(Fd); - {error, _Reason} -> - gs:config(aboutText, {text, "Error: could not read the about file"}) - end, - - gs:config(aboutWin, [{map,true}]), - receive - {gs, okButton, click, _, _} -> - gs:destroy(aboutWin) - end. - -write_text(_Fd, Text, eof) -> - gs:config(aboutText, {text, Text}); -write_text(Fd, Text, More) -> - write_text(Fd, lists:append(Text, More), io:get_line(Fd, "")). diff --git a/lib/gs/contribs/bonk/bonk.gif b/lib/gs/contribs/bonk/bonk.gif Binary files differdeleted file mode 100644 index 3c2299686b..0000000000 --- a/lib/gs/contribs/bonk/bonk.gif +++ /dev/null diff --git a/lib/gs/contribs/bonk/bonk.tool b/lib/gs/contribs/bonk/bonk.tool deleted file mode 100644 index 79ad8f6701..0000000000 --- a/lib/gs/contribs/bonk/bonk.tool +++ /dev/null @@ -1,6 +0,0 @@ -{version,"0.1"}. -{{tool,"Bonk"}, - {start,{bonk,start,[]}}, - {icon,"bonk.gif"}, - {message,"Bonk - The Game"}, - {html,"../bonk/bonk.txt"}}. diff --git a/lib/gs/contribs/bonk/bonk.txt b/lib/gs/contribs/bonk/bonk.txt deleted file mode 100644 index 69c912dbee..0000000000 --- a/lib/gs/contribs/bonk/bonk.txt +++ /dev/null @@ -1,30 +0,0 @@ -BONK! In Erlang for You -by -LENNART OHMAN & MARCUS ARENDT - -After an idea of Mike Darweesh. -Special thanks to Peter Jansson for creating the bitmaps. -Ported to GS 1.1 by Markus Torpvret and Anders Dahlin. - - -INSTRUCTIONS -- Hit as many creatures as possible using the left mouse-button. -- After every 25 hits You will advance one level. For each level You get one bomb. -- Pushing the middle or right mouse-button, in any square, drops a bomb which -wipes out everything. -- The game ends when 10 creatures has escaped from beeing bonked. - - -ABOUT ERLANG -Erlang is a programming language for building robust concurrent systems. It is a single assignment, symbolic language with built in concurrency. It provides unique facilities for error handling and for reloading updated modules in running systems. Erlang was designed and implemented by Joe Armstrong, Robert Virding, and Mike Williams at Ellemtel (now Ericsson Utvecklings AB). - -Please make enquiries about Erlang to: - -Ericsson Software Technology AB -Erlang Systems -Torshamnsgatan 39B -Box 1214 -164 28 Kista -Sweden - -http://www.ericsson.se/erlang
\ No newline at end of file diff --git a/lib/gs/contribs/bonk/bonk_sound.erl b/lib/gs/contribs/bonk/bonk_sound.erl deleted file mode 100644 index 9a0db80e5d..0000000000 --- a/lib/gs/contribs/bonk/bonk_sound.erl +++ /dev/null @@ -1,82 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. 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(bonk_sound). --export([start/0]). - -start() -> - random:seed(), - sounder:start(), - {ok,Bonk}=sounder:new(lists:append(bonk:bonk_dir(),"sounds/bonk.au")), - {ok,Ouch}=sounder:new(lists:append(bonk:bonk_dir(),"sounds/ouch!!!.au")), - {ok,Damn}=sounder:new(lists:append(bonk:bonk_dir(),"sounds/damn.au")), - {ok,Bomb}=sounder:new(lists:append(bonk:bonk_dir(),"sounds/explosion.au")), - {ok,Missed}=sounder:new(lists:append(bonk:bonk_dir(),"sounds/missedme.au")), - {ok,Game_over}=sounder:new(lists:append(bonk:bonk_dir(),"sounds/gameover.au")), - {ok,New_level}=sounder:new(lists:append(bonk:bonk_dir(),"sounds/level.au")), - {ok,Music}=sounder:new(lists:append(bonk:bonk_dir(),"sounds/trumpet.au")), - {ok,Start}=sounder:new(lists:append(bonk:bonk_dir(),"sounds/hehee.au")), - {ok,BestS}=sounder:new(lists:append(bonk:bonk_dir(),"sounds/praisejesus.au")), - {ok,HighS}=sounder:new(lists:append(bonk:bonk_dir(),"sounds/yes.au")), - loop(Bonk, Ouch, Damn, Bomb, Missed, Game_over, New_level, - Music, Start, BestS, HighS). - - -loop(Bonk, Ouch, Damn, Bomb, Missed, Game_over, New_level, Music, Start, BestS, HighS) -> - R=random:uniform(1000), - receive - bonk -> - if - R < 75 -> play_sound(Damn); - R < 275 -> play_sound(Ouch); - true -> play_sound(Bonk) - end; - bomb -> play_sound(Bomb); - missed -> play_sound(Missed); - game_over -> play_sound(Game_over); - new_level -> play_sound(New_level); - music -> play_sound(Music); - start -> play_sound(Start); - best_score -> play_sound(BestS); - high_score -> play_sound(HighS); - quit -> - sounder:stop(), - exit(normal) - end, - loop(Bonk, Ouch, Damn, Bomb, Missed, Game_over, New_level, Music, Start, BestS, HighS). - -play_sound(Snd) -> - case catch sounder:play(Snd) of - {'EXIT', _Reason} -> - io:format("Cannot use audio device!\n"), - sounder:stop(), - silent_loop(); - _Other -> - true - end. - -silent_loop() -> - receive - quit -> - exit(normal); - _Other -> - silent_loop() - end. diff --git a/lib/gs/contribs/bonk/bonk_square.erl b/lib/gs/contribs/bonk/bonk_square.erl deleted file mode 100644 index 98af91944b..0000000000 --- a/lib/gs/contribs/bonk/bonk_square.erl +++ /dev/null @@ -1,146 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. 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(bonk_square). --export([start/1,init/5,alarm/3]). - - - -start(Bmp) -> - spawn_link(bonk_square, init, [Bmp, self(), - random:uniform(10000), - random:uniform(10000), - random:uniform(10000)]). - -init(Bmp, BoardPid, Seed1, Seed2, Seed3) -> - random:seed(Seed1,Seed2,Seed3), - idle(Bmp, BoardPid). - - -idle(Bmp, BoardPid) -> - receive - start -> - Level = 1, - sleep(Level, Bmp, BoardPid, alarm(sleep_time(Level), wake_up)); - quit -> - exit(normal); - _Other -> - idle(Bmp, BoardPid) - end. - - -sleep(Level, Bmp, BoardPid, Alarm) -> - receive - stop -> - Alarm ! quit, - idle(Bmp, BoardPid); - quit -> - Alarm ! quit, - exit(normal); - {new_level, NewLevel} -> - sleep(NewLevel, Bmp, BoardPid, Alarm); - {Alarm, wake_up} -> - show_me(BoardPid, Bmp), - show(Level, Bmp, BoardPid, alarm(2500, missed)); - _Other -> - sleep(Level, Bmp, BoardPid, Alarm) - end. - - -show(Level, Bmp, BoardPid, Alarm) -> - receive - stop -> - Alarm ! quit, - idle(Bmp, BoardPid); - quit -> - Alarm ! quit, - exit(normal); - {new_level, NewLevel} -> - show(NewLevel, Bmp, BoardPid, Alarm); - sleep -> % The board was too crowded. - Alarm ! quit, - sleep(Level, Bmp, BoardPid, alarm(sleep_time(Level), wake_up)); - bonk -> - bonk_me(BoardPid, Bmp), - Alarm ! quit, - bbmed(Level, Bmp, BoardPid, alarm(1500, hide)); - bomb -> - bomb_me(BoardPid, Bmp), - Alarm ! quit, - bbmed(Level, Bmp, BoardPid, alarm(1000, hide)); - {Alarm, missed} -> - missed_me(BoardPid, Bmp), - bbmed(Level, Bmp, BoardPid, alarm(1500, hide)); - _Other -> - show(Level, Bmp, BoardPid, Alarm) - end. - -%% bonked, bombed or missed -bbmed(Level, Bmp, BoardPid, Alarm) -> - receive - stop -> - Alarm ! quit, - idle(Bmp, BoardPid); - quit -> - Alarm ! quit, - exit(normal); - {new_level, NewLevel} -> - bbmed(NewLevel, Bmp, BoardPid, Alarm); - {Alarm, hide} -> - hide_me(BoardPid, Bmp), - sleep(Level, Bmp, BoardPid, alarm(sleep_time(Level), wake_up)); - _Other -> - bbmed(Level, Bmp, BoardPid, Alarm) - end. - - -show_me(BoardPid, Bmp) -> - BoardPid ! {show, self(), Bmp}. - -hide_me(BoardPid, Bmp) -> - BoardPid ! {hide, self(), Bmp}. - -bonk_me(BoardPid, Bmp) -> - BoardPid ! {bonked, self(), Bmp}. - -bomb_me(BoardPid, Bmp) -> - BoardPid ! {bombed, self(), Bmp}. - -missed_me(BoardPid, Bmp) -> - BoardPid ! {missed, self(), Bmp}. - - -%% Count sleep time - -sleep_time(Level) -> - random:uniform((19000 div (Level+1))*2+1500). - -%% Set an alarm - -alarm(Time, Msg) -> - spawn(bonk_square, alarm, [Time, Msg, self()]). - -alarm(Time, Msg, Pid) -> - receive - quit -> exit(normal) - after - Time -> Pid ! {self(), Msg} - end. diff --git a/lib/gs/contribs/bonk/sounder.erl b/lib/gs/contribs/bonk/sounder.erl deleted file mode 100644 index aabcaa1950..0000000000 --- a/lib/gs/contribs/bonk/sounder.erl +++ /dev/null @@ -1,160 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2011. 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(sounder). --export([start/0,play/1,new/1,go/0,stop/0,nosound/0,silent/0]). --include_lib("kernel/include/file.hrl"). -%%---------------------------------------------------------------------- -%% sounder.erl - An interface to /dev/audio -%% -%% Created by: {lennarto,mike}@erix.ericsson.se -%% Modified by: EV,[email protected] -%% -%% Mod: 6 Jun 1996 by [email protected] -%% The executable sounder will no be looked for in the -%% same directory as from where sounder.jam is loaded. -%% -%% -%% start() - Returns either: ok ,or: silent ,where silent means -%% that no audio capabilities exists but the sounder -%% will work "silently" in order to not break any code. -%% -%% stop() - Returns: ok -%% -%% new(File) - Tries to load the File. At success, a number refering -%% to the File is returned that shall be used with send/1. -%% Otherwise {error,Reason} is returned. -%% -%% play(No) - Tries to execute the sound registered with the number No -%% Returns: ok , or: {error,Reason} -%% -%% silent() - Returns: true ,if no audio capabilities exists, else: false -%% -%% Note: It is also possible to receive: {error,sounder_not_started} -%% -%%---------------------------------------------------------------------- - -start() -> - case whereis(sounder) of - undefined -> - %% first we check if the workstation has audio capabilities - case file:read_file_info('/dev/audio') of - {ok, FI} when FI#file_info.access==read_write -> - register(sounder, spawn(sounder,go,[])), - ok; - _Other -> - register(sounder, spawn(sounder,nosound,[])), - silent - end; - _Pid -> - ok - end. - -stop() -> - catch begin check(), - sounder ! {stop}, - ok end. - -new(File) when is_list(File) -> new(list_to_atom(File)); -new(File) when is_atom(File) -> - catch begin check(), - sounder ! {new,File,self()}, - wait_for_ack(sounder) end. - -play(No) when is_integer(No) -> - catch begin check(), - sounder ! {play, No, self()}, - wait_for_ack(sounder) end. - -silent() -> - catch begin check(), - sounder ! {play,silent,self()}, - receive {sounder,Answer} -> Answer end end. - -go() -> - Port = open_port({spawn,lists:append(bonk:bonk_dir(), "sounder")},[{packet, 2}]), - loop(Port). - -loop(Port) -> - receive - {new, File, From} when is_atom(File) -> - Port ! {self(),{command,lists:append([0],atom_to_list(File))}}, - From ! {sounder,wait_for_ack(Port)}, - loop(Port); - {play,silent,From} -> - From ! {sounder,false}, - loop(Port); - {play,No,From} when is_integer(No) -> - Port ! {self(),{command,[No]}}, - From ! {sounder,wait_for_ack(Port)}, - loop(Port); - {stop} -> - Port ! {self(),close}, - exit(normal); - _ -> - loop(Port) - end. - -%% The application using sounds can check on silence itself -%% and refrain from playing sounds. -%% Or it can try to play sounds that will be "consumed in silence" - -nosound() -> - receive - {new,File,From} when is_atom(File) -> - From ! {sounder,{ok,silent}}, - nosound(); - {play,silent,From} -> - From ! {sounder,true}, - nosound(); - {play,No,From} when is_integer(No) -> - From ! {sounder,{error,no_audio_cap}}, - nosound(); - {stop} -> - exit(normal); - _ -> - nosound() - end. - -wait_for_ack(sounder) -> - receive {sounder,Res} -> Res end; -wait_for_ack(Port) when is_port(Port) -> - receive - {Port,{data,"ok"}} -> - ok; - {Port,{data,[No]}} -> - {ok,No}; - {Port,{data,Msg}} -> - {error,list_to_atom(Msg)}; - {'EXIT',Port,_} -> - exit(port_exited) - end. - -check() -> - case whereis(sounder) of - Pid when is_pid(Pid) -> - ok; - undefined -> - throw({error,sounder_not_started}) - end. - - - diff --git a/lib/gs/contribs/bonk/sounds/bonk.au b/lib/gs/contribs/bonk/sounds/bonk.au Binary files differdeleted file mode 100644 index 5e6518898b..0000000000 --- a/lib/gs/contribs/bonk/sounds/bonk.au +++ /dev/null diff --git a/lib/gs/contribs/bonk/sounds/damn.au b/lib/gs/contribs/bonk/sounds/damn.au Binary files differdeleted file mode 100644 index 6117506fb4..0000000000 --- a/lib/gs/contribs/bonk/sounds/damn.au +++ /dev/null diff --git a/lib/gs/contribs/bonk/sounds/explosion.au b/lib/gs/contribs/bonk/sounds/explosion.au Binary files differdeleted file mode 100644 index 78a6964f1a..0000000000 --- a/lib/gs/contribs/bonk/sounds/explosion.au +++ /dev/null diff --git a/lib/gs/contribs/bonk/sounds/gameover.au b/lib/gs/contribs/bonk/sounds/gameover.au Binary files differdeleted file mode 100644 index ca7628f3c6..0000000000 --- a/lib/gs/contribs/bonk/sounds/gameover.au +++ /dev/null diff --git a/lib/gs/contribs/bonk/sounds/hehee.au b/lib/gs/contribs/bonk/sounds/hehee.au Binary files differdeleted file mode 100644 index 10cd16b596..0000000000 --- a/lib/gs/contribs/bonk/sounds/hehee.au +++ /dev/null diff --git a/lib/gs/contribs/bonk/sounds/level.au b/lib/gs/contribs/bonk/sounds/level.au Binary files differdeleted file mode 100644 index 0508c2a6ae..0000000000 --- a/lib/gs/contribs/bonk/sounds/level.au +++ /dev/null diff --git a/lib/gs/contribs/bonk/sounds/missedme.au b/lib/gs/contribs/bonk/sounds/missedme.au Binary files differdeleted file mode 100644 index 4c07c9d428..0000000000 --- a/lib/gs/contribs/bonk/sounds/missedme.au +++ /dev/null diff --git a/lib/gs/contribs/bonk/sounds/music.au b/lib/gs/contribs/bonk/sounds/music.au Binary files differdeleted file mode 100644 index ead6ec79b2..0000000000 --- a/lib/gs/contribs/bonk/sounds/music.au +++ /dev/null diff --git a/lib/gs/contribs/bonk/sounds/ouch!!!.au b/lib/gs/contribs/bonk/sounds/ouch!!!.au Binary files differdeleted file mode 100644 index 78bcf48074..0000000000 --- a/lib/gs/contribs/bonk/sounds/ouch!!!.au +++ /dev/null diff --git a/lib/gs/contribs/bonk/sounds/praisejesus.au b/lib/gs/contribs/bonk/sounds/praisejesus.au Binary files differdeleted file mode 100644 index e299bf66d6..0000000000 --- a/lib/gs/contribs/bonk/sounds/praisejesus.au +++ /dev/null diff --git a/lib/gs/contribs/bonk/sounds/trumpet.au b/lib/gs/contribs/bonk/sounds/trumpet.au Binary files differdeleted file mode 100644 index 2f551b436a..0000000000 --- a/lib/gs/contribs/bonk/sounds/trumpet.au +++ /dev/null diff --git a/lib/gs/contribs/bonk/sounds/yes.au b/lib/gs/contribs/bonk/sounds/yes.au Binary files differdeleted file mode 100644 index c1ce7dfb69..0000000000 --- a/lib/gs/contribs/bonk/sounds/yes.au +++ /dev/null diff --git a/lib/gs/contribs/cols/Makefile b/lib/gs/contribs/cols/Makefile deleted file mode 100644 index 34a900e5ab..0000000000 --- a/lib/gs/contribs/cols/Makefile +++ /dev/null @@ -1,103 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1996-2012. 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_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../../vsn.mk -VSN=$(GS_VSN) - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/gs-$(VSN)/contribs - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- - -MODULES= \ - cols \ - highscore - -HRL_FILES= - -ERL_FILES= $(MODULES:%=%.erl) - -TARGET_FILES= $(MODULES:%=../ebin/%.$(EMULATOR)) $(TARGET_TOOLBOX_FILES) - -TOOLNAME = cols - -EXTRA_FILES= -TOOLBOX_FILES= $(TOOLNAME).tool $(TOOLNAME).gif help.gif -TARGET_TOOLBOX_FILES= $(TOOLBOX_FILES:%=$(EBIN)/%) - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -ERL_COMPILE_FLAGS += - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -debug opt: $(TARGET_FILES) - -docs: - -clean: - rm -f $(TARGET_FILES) - rm -f core - -# ---------------------------------------------------- -# Special Build Targets -# ---------------------------------------------------- - -$(EBIN)/$(TOOLNAME).gif: $(TOOLNAME).gif - $(gen_verbose)rm -f $@ - $(V_at)cp $(TOOLNAME).gif $@ - -$(EBIN)/$(TOOLNAME).tool: $(TOOLNAME).tool - $(gen_verbose)rm -f $@ - $(V_at)cp $(TOOLNAME).tool $@ - -$(EBIN)/help.gif: help.gif - $(gen_verbose)rm -f $@ - $(V_at)cp help.gif $@ - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_spec: opt - $(INSTALL_DIR) "$(RELSYSDIR)/ebin" - $(INSTALL_DATA) $(TARGET_FILES) "$(RELSYSDIR)/ebin" - $(INSTALL_DIR) "$(RELSYSDIR)/cols/bitmaps" - $(INSTALL_DATA) $(BITMAPS) $(TOOLBOX_FILES) "$(RELSYSDIR)/cols/bitmaps" - $(INSTALL_DIR) "$(RELSYSDIR)/cols" - $(INSTALL_DATA) $(ERL_FILES) $(EXTRA_FILES) "$(RELSYSDIR)/cols" - -release_docs_spec: - diff --git a/lib/gs/contribs/cols/cols.erl b/lib/gs/contribs/cols/cols.erl deleted file mode 100644 index 265f2b6ee8..0000000000 --- a/lib/gs/contribs/cols/cols.erl +++ /dev/null @@ -1,625 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2012. 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(cols). --compile([{nowarn_deprecated_function,{gs,config,2}}, - {nowarn_deprecated_function,{gs,create,3}}, - {nowarn_deprecated_function,{gs,create,4}}, - {nowarn_deprecated_function,{gs,destroy,1}}, - {nowarn_deprecated_function,{gs,read,2}}, - {nowarn_deprecated_function,{gs,start,0}}]). - --export([start/0, init/0]). - -%% internal export. --export([make_board_elem/3]). - -%%====================================================================== -%% Contents -%%===================== -%% 1. The actual program -%% 2. Graphics -%% 3. Data structures and stuff -%% 4. Lambdas -%%====================================================================== - - --define(COLORS, {red,green,blue,grey,yellow,{66,153,130}}). --define(HIGHFILE, "./cols.high"). --define(HEIGHT, 17). --define(LEFT, 50). --define(SIZE, 15). --define(VERSION, "v0.9"). --define(WIDTH, 8). - --record(state, {bit,board,nextbit,ticks, score=0}). -%%---------------------------------------------------------------------- -%% Consists of three boxes. -%%---------------------------------------------------------------------- --record(bit, {x,y,topColor, middleColor, bottomColor, - top_gsobj,mid_gsobj,bot_gsobj}). - -%%====================================================================== -%% 1. The actual program -%%====================================================================== - -start() -> - spawn_link(cols,init,[]). - -init() -> - make_graphics(), - {A,B,C} = erlang:now(), - random:seed(A,B,C), - NextBit = make_bit(), - Board = make_screen_board(), - S = #state{bit=make_bit(), board=Board, ticks=update_timer(1), - score=make_score(), nextbit=new_bit_xy(NextBit, -2,5)}, - gs:config(win, [{map, true}]), - loop(S). - -make_graphics() -> - G = gs:start(), - H = ?HEIGHT*?SIZE, - W = ?WIDTH*?SIZE, - BotMargin = 100, - gs:create(window, win, G, [{destroy,true},{map, true},{title, "cols"}, - {height, H+BotMargin}, {width, W+?LEFT+10}, - {bg, grey},{keypress,true}]), - gs:create(canvas, can, win, [{bg, black}, - {height, H+BotMargin}, - {width, W+?LEFT+20}]), - gs:create(text, can, [{text, "Next"}, {coords, [{5, 45}]}, {fg, red}]), - gs:create(image, help, can, [{coords,[{5,7}]}, - {load_gif, dir() ++ "/help.gif"}, - {buttonpress,true}]), - draw_borders(). - -loop(State) -> - receive - Event -> loop(update(Event, State)) - end. - -%%---------------------------------------------------------------------- -%% How fast speed should be doubled -%%---------------------------------------------------------------------- --define(DBL_TICKS, 300). - -update_timer(Ticks) -> - K = 0.001/?DBL_TICKS, - M = 1.001-K, - Q = K*Ticks+M, - Timeout = round(1/math:log(Q)), - timer:send_after(Timeout, self(), fall_timeout), - Ticks+1. - -add_score({ScoreObj, NScore}, DScore) -> - NScore2 = NScore + DScore, - gs:config(ScoreObj, [{text, io_lib:format("Score: ~w", [NScore2])}]), - {ScoreObj, NScore2}. - - -update({gs,_Obj,keypress,_Data, ['Left'|_]}, State) -> - #state{bit=Bit, board = Board} = State, - #bit{x=X,y=Y} = Bit, - if X > 0 -> - case is_board_empty(Board, X-1,Y) of - true -> - State#state{bit=new_bit_xy(Bit, X-1, Y)}; - false -> - State - end; - true -> State - end; - -update({gs,_Obj,keypress,_Data, ['Right'|_]}, State) -> - #state{bit=Bit, board = Board} = State, - #bit{x=X,y=Y} = Bit, - if X < ?WIDTH - 1 -> - case is_board_empty(Board, X+1, Y) of - true -> - State#state{bit=new_bit_xy(Bit, X+1, Y)}; - false -> - State - end; - true -> State - end; - -update({gs,_Obj,keypress,_Data, ['Up'|_]}, State) -> - State#state{bit=shift_bits(State#state.bit)}; - -update({gs,_Obj,keypress,_Data, [Key|_]}, State) -> - case drop_key(Key) of - true -> - #state{bit=Bit, board=Board, score=Score} = State, - #bit{x=X,y=Y} = Bit, - {NewX, NewY, NewScore} = drop(X,Y,Score,Board), - fasten_bit(State#state{bit=new_bit_xy(Bit,NewX, NewY), - score=NewScore}); - false -> State - end; - -update(fall_timeout, State) -> - #state{bit=Bit, board=Board, ticks = Ticks, score=Score} = State, - NewY = Bit#bit.y+1, - X = Bit#bit.x, - case is_fall_ok(Board, X, NewY) of - true -> - State#state{bit=new_bit_xy(Bit, X, NewY), - ticks=update_timer(Ticks), score=add_score(Score, 1)}; - false -> - S1 = fasten_bit(State), - S1#state{ticks=update_timer(Ticks)} - end; - -update({gs,_,destroy,_,_}, _State) -> - exit(normal); - -update({gs,help,buttonpress,_,_}, State) -> - show_help(), - State; - -update(OtherEvent, State) -> - ok=io:format("got other! ~w~n", [OtherEvent]), State. - -drop_key('Down') -> true; -drop_key(space) -> true; -drop_key(_) -> false. - -is_board_empty(Board, X, Y) -> - case {color_at(Board, X, Y), - color_at(Board, X, Y + 1), - color_at(Board, X, Y + 2)} of - {black, black, black} -> true; - _ -> false - end. - -%%---------------------------------------------------------------------- -%% Returns: NewState -%%---------------------------------------------------------------------- -fasten_bit(State) -> - #state{board=Board, bit=Bit, nextbit=NextBit, score=Score} = State, - #bit{x=X,y=Y,topColor=C1,middleColor=C2,bottomColor=C3} = Bit, - B1 = update_screen_element(Board, X, Y, C1), - B2 = update_screen_element(B1, X, Y+1, C2), - B3 = update_screen_element(B2, X, Y+2, C3), - destroy_bit(Bit), - #bit{topColor=NC1,middleColor=NC2,bottomColor=NC3} = NextBit, - {B4, ExtraScore} = erase_bits(B3, [{X,Y},{X,Y+1},{X,Y+2}], 0), - NewBit = make_bit(NC1,NC2,NC3), - case is_board_empty(B4, NewBit#bit.x, NewBit#bit.y) of - true -> - State#state{score=add_score(Score, ExtraScore), - bit=NewBit, nextbit=new_colors(NextBit),board=B4}; - false -> - {_GsObj,Score2}=State#state.score, - highscore:run(Score2,?HIGHFILE), - exit(normal) - end. - -%%---------------------------------------------------------------------- -%% Args: Check: list of {X,Y} to check. -%% Returns: {NewBoard, ExtraScore} -%%---------------------------------------------------------------------- -erase_bits(Board, Checks, ExtraScore) -> - ElemsToDelete = elems2del(Checks,Board,[]), - NDel = length(ElemsToDelete), - if - NDel > 0 -> - Board2 = delete_elems(Board, ElemsToDelete), - {NewBoard, NewCheck} = fall_down(Board2, ElemsToDelete), - if NDel > 3 -> - {B,ES}=erase_bits(NewBoard,NewCheck,ExtraScore+2*NDel), - {NewBoard2, NewCheck2} = bonus(B, NewCheck), - erase_bits(NewBoard2, NewCheck2, ES); - true -> - erase_bits(NewBoard, NewCheck, 2*NDel) - end; - true -> {Board, ExtraScore} - end. - -bonus(Board, Check) -> - Cols = collect_bottom_bits(0,Board), - NewBoard = randomize_columns(5, Board, Cols), - NewCheck = update_check(Check, Cols), - {NewBoard, NewCheck}. - -randomize_columns(0, Board, _) -> Board; -randomize_columns(N, Board, Cols) -> - NewBoard = randomize_columns(Cols,Board), - randomize_columns(N-1, NewBoard, Cols). - -randomize_columns([],Board) -> Board; -randomize_columns([X|Xs],Board) -> - flush(), - timer:sleep(50), - randomize_columns(Xs,update_screen_element(Board,X,?HEIGHT-1,rndColor())). - -%%---------------------------------------------------------------------- -%% Returns: NewBoard -%%---------------------------------------------------------------------- -delete_elems(Board, Elems2Del) -> - OrgObjs = org_objs(Elems2Del,Board), - visual_effect(?SIZE, OrgObjs), - NewBoard = update_board(Elems2Del, Board), - put_back(OrgObjs), - NewBoard. - -visual_effect(0,_OrgObjs) -> done; -visual_effect(Size,OrgObjs) -> - set_size(OrgObjs,Size), - flush(), - timer:sleep(20), - visual_effect(Size-1,OrgObjs). - -set_size([],_Size) -> done; -set_size([{GsObj,[{X1,Y1},{_X2,_Y2}]}|T],Size) -> - gs:config(GsObj, [{coords, [{X1,Y1},{X1+Size,Y1+Size}]}]), - set_size(T,Size). - -%%---------------------------------------------------------------------- -%% Note: Loop over columns where something is removed only. (efficiency) -%% Returns: {ReversedNewColumns (perhaps shorter), Checks} -%% cols:fall_column([a,b,black,black,c,f,black,d,black], 3, 15, [], []). -%% should return: {[a,b,c,f,d],[{3,11},{3,12},{3,13}]} -%%---------------------------------------------------------------------- -fall_column([], _X, _Y, ColumnAcc, ChecksAcc) -> - {ColumnAcc, ChecksAcc}; -fall_column([black|Colors], X, Y, ColumnAcc, ChecksAcc) -> - case find_box(Colors) of - false -> {ColumnAcc, ChecksAcc}; - NewColors when is_list(NewColors) -> - fall_one_step(NewColors, X, Y, ColumnAcc, ChecksAcc) - end; -fall_column([Color|Colors], X, Y, ColumnAcc, ChecksAcc) -> - fall_column(Colors, X, Y-1, [Color | ColumnAcc], ChecksAcc). - -find_box([]) -> false; -find_box([black|Colors]) -> - find_box(Colors); -find_box([Color|Colors]) -> [Color|Colors]. - -%%---------------------------------------------------------------------- -%% Enters: ([a,b, , ,c,d], 3, 8, Q) -%% Leaves: ([b,a|Q], [ , , ,c,d], 10, [{3,8},{4,9}]) -%%---------------------------------------------------------------------- -fall_one_step([], X, Y, ColumnAcc, Checks) -> - fall_column([], X, Y, ColumnAcc, Checks); -fall_one_step([black|Colors], X, Y, ColumnAcc, Checks) -> - fall_column([black|Colors], X, Y, ColumnAcc, Checks); -fall_one_step([Color|Colors], X, Y, ColumnAcc, Checks) -> - fall_one_step(Colors, X, Y-1, [Color|ColumnAcc],[{X,Y}|Checks]). - -%%---------------------------------------------------------------------- -%% Returns: {NewBoard, NewChecks} -%%---------------------------------------------------------------------- -fall_down(Board1, Elems2Del) -> - UpDatedCols = updated_cols(Elems2Del, []), - fall_column(UpDatedCols, Board1, []). - -fall_column([], NewBoard, NewChecks) -> {NewBoard, NewChecks}; -fall_column([X|Xs], BoardAcc, ChecksAcc) -> - OrgColumn = boardcolumn_to_tuple(BoardAcc, X), - Column = columntuple_to_list(OrgColumn), - {NewColumn, NewChecksAcc} = fall_column(Column, X,?HEIGHT-1,[],ChecksAcc), - NewBoardAcc = - set_board_column(BoardAcc,X,new_column_list(NewColumn,OrgColumn)), - fall_column(Xs,NewBoardAcc,NewChecksAcc). - -new_column_list(NewColumn, ColumnTuple) -> - Nempty = ?HEIGHT - length(NewColumn), - L = make_list(black, Nempty) ++ NewColumn, - new_column_list(L, 1, ColumnTuple). - -new_column_list([H|T], N, Tuple) -> - {GsObj, Color} = element(N, Tuple), - [update_screen_element({GsObj, Color},H) | new_column_list(T, N+1, Tuple)]; -new_column_list([], _, _) -> []. - - -%%---------------------------------------------------------------------- -%% Returns: a reversed list of colors. -%%---------------------------------------------------------------------- -columntuple_to_list(ColumnTuple) when is_tuple(ColumnTuple) -> - columntuple_to_list(tuple_to_list(ColumnTuple),[]). - -columntuple_to_list([],Acc) -> Acc; -columntuple_to_list([{_GsObj, Color}|T],Acc) -> - columntuple_to_list(T,[Color|Acc]). - -%%====================================================================== -%% 2. Graphics -%%====================================================================== - -make_bit() -> - make_bit(rndColor(),rndColor(),rndColor()). - -make_bit(Tc,Mc,Bc) -> - X = ?WIDTH div 2, - Y = 0, - #bit{x=X,y=Y,topColor= Tc, middleColor=Mc, bottomColor=Bc, - top_gsobj = make_box(X,Y,Tc), mid_gsobj=make_box(X,Y+1,Mc), - bot_gsobj=make_box(X,Y+2,Bc)}. - -new_colors(Bit) -> - #bit{top_gsobj=T,mid_gsobj=M,bot_gsobj=B} = Bit, - Tc = rndColor(), - Mc = rndColor(), - Bc = rndColor(), - gs:config(T, [{fill, Tc}]), - gs:config(M, [{fill, Mc}]), - gs:config(B, [{fill, Bc}]), - Bit#bit{topColor= Tc, middleColor=Mc, bottomColor=Bc}. - -new_bit_xy(Bit, NewX, NewY) -> - #bit{x=X,y=Y,top_gsobj=T,mid_gsobj=M,bot_gsobj=B} = Bit, - Dx = (NewX - X) * ?SIZE, - Dy = (NewY - Y) * ?SIZE, - gs:config(T, [{move, {Dx, Dy}}]), - gs:config(M, [{move, {Dx, Dy}}]), - gs:config(B, [{move, {Dx, Dy}}]), - Bit#bit{x=NewX, y=NewY}. - -destroy_bit(#bit{top_gsobj=T,mid_gsobj=M,bot_gsobj=B}) -> - gs:destroy(T), - gs:destroy(M), - gs:destroy(B). - -shift_bits(Bit) -> - #bit{topColor=C1,middleColor=C2,bottomColor=C3, - top_gsobj=T,mid_gsobj=M,bot_gsobj=B} = Bit, - gs:config(T, {fill,C2}), - gs:config(M, {fill,C3}), - gs:config(B, {fill,C1}), - Bit#bit{topColor=C2, middleColor=C3, bottomColor=C1}. - -rndColor() -> - Siz = size(?COLORS), - element(random:uniform(Siz), ?COLORS). - -make_score() -> - {gs:create(text, can, [{text, "Score: 0"}, {fg, red}, - {coords, [{5,?HEIGHT*?SIZE+10}]}]), 0}. - -make_screen_board() -> - xy_loop({cols,make_board_elem}, make_board(), ?WIDTH, ?HEIGHT). - -make_board_elem(X,Y,Board) -> - set_board_element(Board,X,Y,{make_box(X,Y,black),black}). - -flush() -> gs:read(can, bg). - -draw_borders() -> - BotY = ?HEIGHT*?SIZE, - RightX = ?LEFT + ?SIZE*?WIDTH, - LeftX = ?LEFT - 1, - gs:create(line,can,[{coords,[{LeftX,0},{LeftX,BotY}]},{fg,white}]), - gs:create(line,can,[{coords,[{LeftX,BotY},{RightX,BotY}]},{fg,white}]), - gs:create(line,can,[{coords,[{RightX,0},{RightX, BotY}]}, {fg,white}]). - -update_screen_element(ScrBoard, X, Y, Color) -> - case board_element(ScrBoard,X,Y) of - {_GsObj, Color} -> - ScrBoard; % don't have to update screen - {GsObj, _ScreenColor} -> - gs:config(GsObj, color_args(Color)), - set_board_element(ScrBoard, X, Y, {GsObj, Color}) - end. - -update_screen_element(ScrElem, Color) -> - case ScrElem of - {_GsObj, Color} -> - ScrElem; % don't have to update screen - {GsObj, _ScreenColor} -> - gs:config(GsObj, color_args(Color)), - {GsObj, Color} - end. - - -color_args(black) -> [{fg,black},{fill,black}]; -color_args(Color) -> [{fg,white},{fill,Color}]. - -%%====================================================================== -%% 3. Data structures and stuff -%%====================================================================== - -xy_loop(Fun, Acc, XMax, YMax) -> - xy_loop(Fun, Acc, 0, 0, XMax, YMax). - -xy_loop(_Fun, Acc, _X, YMax, _XMax, YMax) -> Acc; -xy_loop(Fun, Acc, XMax, Y, XMax, YMax) -> - xy_loop(Fun, Acc, 0, Y+1, XMax, YMax); -xy_loop(Fun, Acc, X, Y, XMax, YMax) -> - xy_loop(Fun, apply(Fun, [X, Y,Acc]), X+1,Y,XMax, YMax). - -%%---------------------------------------------------------------------- -%% Returns: a sorted list of {X,Y} to delete. -%% Pre: PrevDelElems is sorted. -%%---------------------------------------------------------------------- -erase_bits_at(Board, PrevDelElems, X,Y) -> - C = color_at(Board, X, Y), - erase_bits_at([vert, horiz, slash, backslash],X,Y,C,Board,PrevDelElems). - -erase_bits_at([], _X,_Y,_C,_Board, Elems2Del) -> Elems2Del; -erase_bits_at([Dir|Ds],X,Y,C,Board, Elems2DelAcc) -> - Dx = dx(Dir), - Dy = dy(Dir), - DelElems = lists:append(check_dir(Board, X-Dx,Y-Dy,-Dx,-Dy,C), - check_dir(Board, X,Y,Dx,Dy,C)), - N_in_a_row = length(DelElems), - if N_in_a_row >= 3 -> - erase_bits_at(Ds,X,Y,C,Board, - ordsets:union(lists:sort(DelElems),Elems2DelAcc)); - true -> erase_bits_at(Ds,X,Y,C,Board,Elems2DelAcc) - end. - -dx(vert) -> 0; -dx(horiz) -> 1; -dx(slash) -> 1; -dx(backslash) -> -1. - -dy(vert) -> -1; -dy(horiz) -> 0; -dy(slash) -> -1; -dy(backslash) -> -1. - - -%%---------------------------------------------------------------------- -%% Returns: list of {X,Y} to delete. -%%---------------------------------------------------------------------- -check_dir(Board, X, Y, Dx, Dy, Color) - when X >= 0, X < ?WIDTH, Y >= 0, Y < ?HEIGHT -> - case color_at(Board, X, Y) of - Color -> - [{X,Y} | check_dir(Board, X+Dx, Y+Dy, Dx, Dy, Color)]; - _OtherColor -> - [] - end; -check_dir(_Board, _X, _Y, _Dx, _Dy, _Color) -> []. - -make_box(X, Y, Color) -> - make_box(X, Y, 1, 1, Color). - -%%---------------------------------------------------------------------- -%% Returns: GsObj -%%---------------------------------------------------------------------- -make_box(X, Y, Height, Width, Color) -> - Opts = if Color == black -> [{fg, black}, {fill, black}]; - true -> [{fill, Color}, {fg, white}] end, - gs:create(rectangle, can, [{coords, [{?LEFT + X * ?SIZE, Y * ?SIZE}, - {?LEFT + X * ?SIZE + (?SIZE*Width)-1, - Y * ?SIZE + (?SIZE*Height)-1}]}|Opts]). - -is_fall_ok(_Board, _NewX, NewY) when NewY+2 >= ?HEIGHT -> false; -is_fall_ok(Board, NewX, NewY) -> - case color_at(Board, NewX, NewY+2) of - black -> - true; - _ -> false - end. - -color_at(Board, X, Y) -> - {_GsObj, Color} = board_element(Board, X, Y), - Color. - - -%%---------------------------------------------------------------------- -%% X:0..?WIDTH-1, Y:0..?HEIGHT -%%---------------------------------------------------------------------- -make_board() -> - list_to_tuple(make_list(make_column(), ?WIDTH)). - -board_element(Board, X, Y) -> - element(Y+1, element(X+1, Board)). - -set_board_element(Board, X, Y, NewValue) -> - Col = element(X+1, Board), - NewCol=setelement(Y+1,Col, NewValue), - setelement(X+1, Board, NewCol). - -make_column() -> - list_to_tuple(make_list(black, ?HEIGHT)). - -make_list(_Elem, 0) -> []; -make_list(Elem, N) -> [Elem|make_list(Elem,N-1)]. - -boardcolumn_to_tuple(Board, X) -> - element(X+1, Board). - -set_board_column(Board, X, NewCol) when length(NewCol) == ?HEIGHT -> - setelement(X+1, Board, list_to_tuple(NewCol)). - -show_help() -> - W = gs:create(window, win, [{title, "cols Help"}, {width, 300}, - {height,300}, {map, true}]), - gs:create(label, W, [{x,0},{y,0},{height, 200},{width,300},{justify,center}, - {label, {text, - "cols $Revision: 1.23 $" - "\nby\n" - "Klas Eriksson, [email protected]\n\n" - "Help: Use arrows and space keys.\n" - " Try to get 3 in-a-row.\n" - " More than 3 gives bonus."}}]), - B=gs:create(button, W, [{x,100},{y,250}, {label, {text, "Dismiss"}}]), - receive - {gs, B, click, _, _} -> ok - end, - gs:destroy(W). - -%%====================================================================== -%% 4. Lambdas -%%====================================================================== - -drop(X,Y,Score,Board) -> - case is_fall_ok(Board, X, Y+1) of - true -> drop(X,Y+1,add_score(Score, 1),Board); - false -> {X,Y, Score} - end. - -elems2del([], _Board,Elems2DelAcc) -> Elems2DelAcc; -elems2del([{X,Y}|Checks],Board,Elems2DelAcc) -> - NewElems2DelAcc = ordsets:union(erase_bits_at(Board,Elems2DelAcc,X,Y), - Elems2DelAcc), - elems2del(Checks,Board,NewElems2DelAcc). - -collect_bottom_bits(?WIDTH,_Board) -> []; -collect_bottom_bits(X,Board) -> - case color_at(Board, X, ?HEIGHT-1) of - black -> collect_bottom_bits(X+1,Board); - _AcolorHere -> [X|collect_bottom_bits(X+1,Board)] - end. - -update_check(_Check,[]) -> []; -update_check(Check,[X|Xs]) -> - case lists:member({X, ?HEIGHT-1}, Check) of - true -> update_check(Check,Xs); - false -> [{X, ?HEIGHT-1}|update_check(Check,Xs)] - end. - -org_objs([],_Board) -> []; -org_objs([{X,Y}|XYs],Board) -> - {GsObj, _Color} = board_element(Board, X, Y), - [{GsObj, lists:sort(gs:read(GsObj, coords))}|org_objs(XYs,Board)]. - -update_board([],Board) -> Board; -update_board([{X,Y}|XYs], Board) -> - update_board(XYs,update_screen_element(Board, X, Y, black)). - -put_back([]) -> done; -put_back([{GsObj, Coords}|Objs]) -> - gs:config(GsObj, [{coords, Coords}]), - put_back(Objs). - -updated_cols([], UpdColsAcc) -> UpdColsAcc; -updated_cols([{X,_Y}|XYs], UpdColsAcc) -> - case lists:member(X,UpdColsAcc) of - true -> updated_cols(XYs,UpdColsAcc); - false -> updated_cols(XYs,[X|UpdColsAcc]) - end. - -%% This is not an application so we don't have their way of knowing -%% a private data directory where the GIF files are located (this directory). -%% We can find GS and makes it relative from there /kgb - --define(EbinFromGsPriv,"../contribs/ebin"). - -dir()-> - GsPrivDir = code:priv_dir(gs), - filename:join(GsPrivDir,?EbinFromGsPriv). diff --git a/lib/gs/contribs/cols/cols.gif b/lib/gs/contribs/cols/cols.gif Binary files differdeleted file mode 100644 index 96e7c1ed4a..0000000000 --- a/lib/gs/contribs/cols/cols.gif +++ /dev/null diff --git a/lib/gs/contribs/cols/cols.tool b/lib/gs/contribs/cols/cols.tool deleted file mode 100644 index 673c3d8efa..0000000000 --- a/lib/gs/contribs/cols/cols.tool +++ /dev/null @@ -1,5 +0,0 @@ -{version,"0.1"}. -{{tool,"Cols"}, - {start,{cols,start,[]}}, - {icon,"cols.gif"}, - {message,"Cols - The Game"}}. diff --git a/lib/gs/contribs/cols/help.gif b/lib/gs/contribs/cols/help.gif Binary files differdeleted file mode 100644 index 59baef1fec..0000000000 --- a/lib/gs/contribs/cols/help.gif +++ /dev/null diff --git a/lib/gs/contribs/cols/highscore.erl b/lib/gs/contribs/cols/highscore.erl deleted file mode 100644 index 94f68a043a..0000000000 --- a/lib/gs/contribs/cols/highscore.erl +++ /dev/null @@ -1,103 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2012. 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(highscore). --compile([{nowarn_deprecated_function,{gs,button,2}}, - {nowarn_deprecated_function,{gs,create,3}}, - {nowarn_deprecated_function,{gs,destroy,1}}, - {nowarn_deprecated_function,{gs,grid,2}}, - {nowarn_deprecated_function,{gs,read,2}}, - {nowarn_deprecated_function,{gs,start,0}}, - {nowarn_deprecated_function,{gs,window,2}}]). - --export([run/2]). - -run(NScore, File) -> - Scores = read_scores(File), - case find_pos(NScore, 1, Scores) of - false -> - display(Scores); - Pos -> - NewScores = new_highscore(Scores, Pos, NScore), - write_scores(NewScores,File), - display(NewScores) - end. - - -new_highscore(Scores, Pos, NScore) -> - Txt = io_lib:format("You entered position ~w", [Pos]), - W = gs:create(window, gs:start(), [{width, 200},{height, 110},{map,true}, - {title, "New Highscore!!!"}]), - gs:create(label, W, [{label, {text, Txt}}, {x, 0}, {y,0}, {align, center}, - {width, 190},{height, 30}]), - Entry = gs:create(entry, W, [{x, 0}, {y, 40}, {height, 30}, {width, 200}]), - Ok = gs:create(button, W, [{label, {text, "Ok"}}, {x, 40}, {y, 75}]), - receive - {gs, Ok, click, _,_} -> - T = gs:read(Entry, text), - gs:destroy(W), - lists:sublist(lists:reverse( - lists:keysort(1, [{NScore, T} | Scores])), 1, 10) - end. - - - -read_scores(File) -> - case file:read_file(File) of - {ok, Bin} -> binary_to_term(Bin); - {error, _Reason} -> - mk_empty_high(10) - end. - -mk_empty_high(0) -> []; -mk_empty_high(N) -> [{N,"Erlang"}|mk_empty_high(N-1)]. - -find_pos(_NScore, _N, []) -> false; -find_pos(NScore, N, [{Score, _Name} | Scores]) when Score > NScore -> - find_pos(NScore, N+1, Scores); -find_pos(_NScore, N, _) -> N. - -write_scores(Scores,File) -> - file:write_file(File, term_to_binary(Scores)). - -display(Scores) -> - Win = gs:window(gs:start(), [{width, 300},{height, 250},{map,true}, - {title, "Highscores"}]), - {W,H} = gs:read(Win,{font_wh,{{screen,12},"aaaaaaa"}}), - G = gs:grid(Win,[{rows,{1,11}},{columnwidths,[W,4*W]},{hscroll,false}, - {width, 300},{height, 220},{vscroll,false}, - {cellheight,H+2},{font,{screen,12}}]), - insert_scores(G,2,Scores), - Ok = gs:button(Win, [{label, {text, "OK"}}, {x, 100}, {y, 220}]), - receive - {gs, Ok, click, _,_} -> gs:destroy(Win), - ok - end. - -insert_scores(Grid,_N,[]) -> - gs:create(gridline,Grid,[{row,1},{font,{screen,bold,12}}, - {text,{1,"SCORE"}},{text,{2,"NAME"}}]); - -insert_scores(Grid,Row,[{Score,Name}|Ss]) -> - gs:create(gridline,Grid,[{row,Row},{text,{1,io_lib:format("~w",[Score])}}, - {text,{2,Name}}]), - insert_scores(Grid,Row+1,Ss). - diff --git a/lib/gs/contribs/mandel/Makefile b/lib/gs/contribs/mandel/Makefile deleted file mode 100644 index b806cc7801..0000000000 --- a/lib/gs/contribs/mandel/Makefile +++ /dev/null @@ -1,101 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1996-2012. 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_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../../vsn.mk -VSN=$(GS_VSN) - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/gs-$(VSN)/contribs - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- - -MODULES= \ - mandel - -HRL_FILES= - -ERL_FILES= $(MODULES:%=%.erl) - -TARGET_FILES= $(MODULES:%=../ebin/%.$(EMULATOR)) $(TARGET_TOOLBOX_FILES) - -TOOLNAME = mandel - -EXTRA_FILES= $(TOOLNAME).html -TOOLBOX_FILES= $(TOOLNAME).tool $(TOOLNAME).gif -TARGET_TOOLBOX_FILES= $(TOOLBOX_FILES:%=$(EBIN)/%) - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -ERL_COMPILE_FLAGS += - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -debug opt: $(TARGET_FILES) - -docs: - -clean: - rm -f $(TARGET_FILES) - rm -f core - -# ---------------------------------------------------- -# Special Build Targets -# ---------------------------------------------------- - -$(EBIN)/$(TOOLNAME).gif: $(TOOLNAME).gif - $(gen_verbose)rm -f $@ - $(V_at)cp $(TOOLNAME).gif $@ - -$(EBIN)/$(TOOLNAME).tool: $(TOOLNAME).tool - $(gen_verbose)rm -f $@ - $(V_at)cp $(TOOLNAME).tool $@ - -$(EBIN)/help.gif: help.gif - $(gen_verbose)rm -f $@ - $(V_at)cp help.gif $@ - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_spec: opt - $(INSTALL_DIR) "$(RELSYSDIR)/ebin" - $(INSTALL_DATA) $(TARGET_FILES) "$(RELSYSDIR)/ebin" - $(INSTALL_DIR) "$(RELSYSDIR)/mandel/bitmaps" - $(INSTALL_DATA) $(BITMAPS) $(TOOLBOX_FILES) "$(RELSYSDIR)/mandel/bitmaps" - $(INSTALL_DIR) "$(RELSYSDIR)/mandel" - $(INSTALL_DATA) $(ERL_FILES) $(EXTRA_FILES) "$(RELSYSDIR)/mandel" - -release_docs_spec: diff --git a/lib/gs/contribs/mandel/mandel.erl b/lib/gs/contribs/mandel/mandel.erl deleted file mode 100644 index e6061ba77d..0000000000 --- a/lib/gs/contribs/mandel/mandel.erl +++ /dev/null @@ -1,351 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2013. 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(mandel). --compile([{nowarn_deprecated_function,{gs,assq,2}}, - {nowarn_deprecated_function,{gs,config,2}}, - {nowarn_deprecated_function,{gs,create,4}}, - {nowarn_deprecated_function,{gs,image,2}}, - {nowarn_deprecated_function,{gs,start,0}}]). --author('(mbj,eklas)@erlang.ericsson.se'). - -%% User's interface --export([start/0,start/1]). - -%% Internal exports: --export([start_client/2,refresher/1,start_server/1,respond/2]). - -%%%----------------------------------------------------------------- -%%% Distributed Mandelbrot program. -%%% Originally written i C++/rpc/lwp/interviews by Klas Eriksson.(1200 lines) -%%% Rewritten in Erlang by Klas Eriksson and Martin Björklund. -%%%----------------------------------------------------------------- - -%% unix>erl -sname foo (all nodes will get the same name) -%% (foo@data)1>mandel:start([{hosts,["computer1","computer2"]},{window,400}]). - -%% unix>erl -%% 1> mandel:start(). - --record(state,{image,width,height,xmax,ymax,range, - maxiter,colortable,zoomstep}). --record(job,{left,right,ymin,ymax,height,width,maxiter,data=[]}). --define(JOBWIDTH,10). - -%%----------------------------------------------------------------- -%% This is the client start function. -%%----------------------------------------------------------------- -start() -> - start([]). - -%%---------------------------------------------------------------------- -%% Option is list of Option. Option is: -%% {xmax,float()}|{ymax,float()}|{range,float()}| -%% {maxiter,integer()}|{window,integer()}|{zoomstep,float()}| -%% {hosts,(list of string())|all_found_nodes} -%%---------------------------------------------------------------------- -start(Opts) -> - Nodes1 = nodes(), - Nodes = case get_option(hosts,Opts,all_found_nodes) of - all_found_nodes when Nodes1 == [] -> - N = [node()], - spawn(mandel,start_server,[N]), - N; - all_found_nodes -> - start_nodes(dir(),Nodes1), - Nodes1; - Hosts -> - start_slaves(Hosts), - start_nodes(dir(),Nodes1), - Nodes1 - end, - spawn(mandel,start_client,[Opts,Nodes]). - -%% This is not an application so we don't have their way of knowing -%% a private data directory where the GIF files are located (this directory). -%% We can find GS and makes it relative from there /kgb - --define(EbinFromGsPriv,"../contribs/ebin"). - -dir()-> - GsPrivDir = code:priv_dir(gs), - filename:join(GsPrivDir,?EbinFromGsPriv). - - -start_slaves([]) -> ok; -start_slaves([Host|Hs]) -> - {ok,Name}=slave:start(Host), - io:format("host ~p is up~n", [Name]), - start_slaves(Hs). - -start_nodes(_Dir,[]) -> ok; -start_nodes(Dir,[Node|Nodes]) -> - rpc:call(Node,code,add_path,[Dir]), % hack? should be done in .erlang - spawn_link(Node,mandel,start_server,[[node()]]), - io:format("started mandelserver at node: ~p~n", [Node]), - start_nodes(Dir,Nodes). - -start_client(Opts,Nodes) -> - Wt = get_option(window,Opts,100) div ?JOBWIDTH * ?JOBWIDTH, - Ht = get_option(window,Opts,100) div ?JOBWIDTH * ?JOBWIDTH, - S=gs:start(), - Win=gs:create(window,win1,S,[{title,"Mandel"},{width,Wt-1},{height,Ht-1}, - {configure,true}]), - Canvas=gs:create(canvas,can1,Win,[{width,Wt},{height,Ht}]), - Image=gs:image(Canvas,[{buttonpress,true}]), - MaxIters = get_option(maxiter,Opts,100), - timer:apply_after(8000,mandel,refresher,[Image]), - CT = make_color_table(MaxIters), - State2=#state{image=Image,width=Wt,height=Ht, - xmax=try_random(get_option(xmax,Opts,2),-2,2), - ymax=try_random(get_option(ymax,Opts,2),-2,2), - range=try_random(get_option(range,Opts,4),0,4), - maxiter=MaxIters,colortable=CT, - zoomstep=get_option(zoomstep,Opts,1.7)}, - ToDo = make_jobs(State2), - gs:config(Win,[{map,true}]), - main(State2, [], Nodes, ToDo). - -try_random(random,Low,High) -> - random:uniform()*(High-Low)+Low; -try_random(Float,_Low,_High) when is_number(Float) -> Float. - - -%%----------------------------------------------------------------- -%% Distribute work to the nodes. When a node returns, that -%% node is the first to be used if there's any job left. -%%----------------------------------------------------------------- -main(State, [], PassiveNodes, []) -> - wait_event(State,[],PassiveNodes,[]); -main(State, ActiveNodes, PassiveNodes, []) -> - % No jobs left, but some nodes are still active. - % Wait_Event for their results - wait_event(State,ActiveNodes,PassiveNodes,[]); -main(State, ActiveNodes, [Node|PassiveNodes], [Job|ToDo]) -> - % We have work to do, and at least one passive node. - % Let him do it. - distribute_job(Node, Job), - main(State, [Node|ActiveNodes], PassiveNodes, ToDo); -main(State, ActiveNodes, [], ToDo) -> - % We have work to do, but all nodes are active. - _Node = wait_event(State,ActiveNodes,[],ToDo). - -wait_event(State,ActiveNodes,PassiveNodes,ToDo) -> - receive - {calculation_done, {Node, Job}} -> - if % a small hack. we want to discard data for old pictures - Job#job.ymax==State#state.ymax -> - draw(State, Node, Job); - true -> true - end, - main(State,lists:delete(Node,ActiveNodes),[Node|PassiveNodes],ToDo); - {gs,_Img,buttonpress,_Data,[_Butt,X,Y|_]} -> - #state{width=W,height=H,ymax=Ymax,xmax=Xmax,range=R,zoomstep=ZS} = - State, - RX = Xmax-R+(X/W)*R, - RY = Ymax-R+(1-(Y/H))*R, - R2 = R/ZS, - Xmax2 = RX + R2/2, - Ymax2 = RY + R2/2, - State2 = State#state{xmax=Xmax2,ymax=Ymax2,range=R2}, - io:format("{xmax,~w},{ymax,~w},{range,~w}~n", [Xmax2,Ymax2,R2]), - ToDo2=make_jobs(State2), - main(State2,ActiveNodes,PassiveNodes,ToDo2); - {gs,_Win,destroy,_,_} -> - kill_nodes(lists:append(ActiveNodes,PassiveNodes)); - {gs,_Win,configure,_Data,[W,H|_]} - when State#state.width==W+1, State#state.height==H+1-> - main(State,ActiveNodes,PassiveNodes,ToDo); - {gs,_Win,configure,_Data,[W|_]} -> - gs:config(can1,[{width,W},{height,W}]), - gs:config(win1,{configure,false}), - gs:config(win1,[{width,W-1},{height,W-1}]), - gs:config(win1,{configure,true}), - State2 = State#state{width=W,height=W}, - ToDo2=make_jobs(State2), - main(State2,ActiveNodes,PassiveNodes,ToDo2) - end. - -kill_nodes([]) -> - done; -kill_nodes([Node|Nodes]) -> - exit(rpc:call(Node,erlang,whereis,[mandel_server]),kill), - kill_nodes(Nodes). - - -distribute_job(Node, Job) -> - {mandel_server, Node} ! {mandel_job, {self(), Job}}. - -draw(#state{image=Image, width=Wt, height=Ht, xmax=Xmax, - maxiter=MI,colortable=ColorTable,range=R}, Node, Job) -> - #job{left=Left,data=Data}=Job, - io:format("Got data from node ~30w~n", [Node]), -%% PixelX = K * RealX + M -%% 0 = K * Xmin + M -%% Width-1= K * Xmax + M - K=(1-Wt)/-R, - M=Wt-1-K*Xmax, - Xbegin = round(Left*K+M), - draw_cols(Image, Xbegin, Ht, lists:reverse(Data),MI,ColorTable). - -draw_cols(Image, X, Ht, [H|T],MaxIter,ColorTable) -> - draw_col(Image, X, 0, H,MaxIter,ColorTable), - draw_cols(Image, X+1, Ht, T,MaxIter,ColorTable); -draw_cols(_Image, _X, _, [],_MaxIter,_ColorTable) -> - done. - -draw_col(_Image, _X,_Y,[{no_first_color,0}],_MaxIter,_ColorTable) -> - done; -draw_col(Image, X,Y,[{Color,1}|T],MaxIter,ColorTable) -> - gs:config(Image,[{pix_val,{{X,Y}, - element(Color+1,ColorTable)}}]), - draw_col(Image, X,Y+1,T,MaxIter,ColorTable); -draw_col(Image, X,Y,[{Color,Height}|T],MaxIter,ColorTable) -> - gs:config(Image,[{pix_val,{{{X,Y},{X+1,Y+Height}}, - element(Color+1,ColorTable)}}]), - draw_col(Image, X,Y+Height,T,MaxIter,ColorTable). - -make_jobs(#state{width=W,height=H,range=R, - xmax=Xmax,ymax=Ymax,maxiter=MI}) -> - make_jobs(Xmax-R,Xmax,Ymax-R,Ymax,H,W,MI). - -make_jobs(Xmin,Xmax,Ymin,Ymax,Ht,Wt,MaxIter) -> - NoJobs = Wt/?JOBWIDTH, % Each job is ?JOBWIDTH pixel-col - DX = (Xmax - Xmin)/NoJobs, - make_jobs(DX,Xmin,Xmax,#job{ymin=Ymin,ymax=Ymax,height=Ht,width=Wt/NoJobs, - maxiter=MaxIter},[]). - -make_jobs(DX,Left,Xmax,JobSkel,Res) when Left =< Xmax -> - Right = Left + DX, - Job = JobSkel#job{left=Left,right=Right}, - make_jobs(DX,Right,Xmax,JobSkel,[Job | Res]); -make_jobs(_DX,_Left,_Xmax,_JobSkel,Res) -> Res. - -%%---------------------------------------------------------------------- -%% A small process that refreshes the screen now and then. -%%---------------------------------------------------------------------- -refresher(Image) -> - gs:config(Image,flush), - timer:apply_after(8000,mandel,refresher,[Image]). - -%%----------------------------------------------------------------- -%% This is the server start function. -%%----------------------------------------------------------------- -start_server([ClientNode]) -> - register(mandel_server, self()), - erlang:monitor_node(ClientNode, true), - server_loop(). - -server_loop() -> - receive - {mandel_job, {Pid, Job}} -> - spawn_link(mandel, respond, [Pid, Job]), - server_loop() - end. - -respond(Pid, Job) -> - Data = do_job(Job), - Pid ! {calculation_done, {node(), Data}}. - -do_job(Job) -> - calculate_area(Job). - -calculate_area(Job) -> - #job{ymin=Ymin,ymax=Ymax,height=Ht,width=Wt,left=Xmin,right=Xmax}=Job, - Job#job{data=x_loop(0,[],Wt,(Xmax-Xmin)/Wt,(Ymax-Ymin)/Ht,Xmin,Job)}. - -x_loop(IX,Res,Wt,Dx,Dy,X,Job) when IX < Wt -> - #job{ymin=Ymin,height=Ht,maxiter=MaxIter}=Job, - Cols = y_loop(0,Ht,[],MaxIter,Dy,X,Ymin,no_first_color,0), - x_loop(IX+1,[Cols|Res],Wt,Dx,Dy,X+Dx,Job); -x_loop(_,Res,_,_,_,_,_) -> - Res. - -y_loop(IY,Ht,Res,MaxIter,Dy,X,Y,PrevColor,NprevColor) when IY < Ht -> - Color = color_loop(1,MaxIter,0,0,0,0,X,Y), - if - Color == PrevColor -> - y_loop(IY+1,Ht,Res,MaxIter,Dy,X,Y+Dy,PrevColor,NprevColor+1); - true -> - y_loop(IY+1,Ht,[{PrevColor,NprevColor}|Res],MaxIter, - Dy,X,Y+Dy,Color,1) - end; - -y_loop(_,_,Res,_,_,_,_,PC,N) -> - [{PC,N}|Res]. - -color_loop(Color,MaxIter,Za,Zb,Za2,Zb2,X,Y) - when Za2 + Zb2 < 4, Color < MaxIter-> - Ztmp = Za2 - Zb2 + X, - ZbN = 2 * Za * Zb + Y, - color_loop(Color+1,MaxIter,Ztmp,ZbN,Ztmp * Ztmp,ZbN * ZbN,X,Y); -color_loop(MaxIter,MaxIter,_Za,_Zb,_Za2,_Zb2,_X,_Y) -> - 0; % black -color_loop(Color,_,_,_,_,_,_,_) -> - Color. - -%%---------------------------------------------------------------------- -%% The "colormodel". -%%---------------------------------------------------------------------- -make_color_table(MaxColors) -> - list_to_tuple([{0,0,0}|colors(MaxColors)]). - -colors(Ncolors) -> - {A,B,C}=erlang:now(), - random:seed(A,B,C), - Colors = random_colors(Ncolors), - Colors2 = best_insert([hd(Colors)],tl(Colors)), - Colors2. - -random_colors(0) -> []; -random_colors(N) -> - R = random:uniform(256)-1, - G = random:uniform(256)-1, - B = random:uniform(256)-1, - [{R,G,B}|random_colors(N-1)]. - -best_insert(Sorted,[RGB|Unsorted]) -> - best_insert(insert_at(best_pos(RGB,Sorted),RGB,Sorted),Unsorted); -best_insert(Sorted,[]) -> Sorted. - -insert_at(1,Elem,L) -> [Elem|L]; -insert_at(N,Elem,[H|T]) -> [H|insert_at(N-1,Elem,T)]. - -best_pos(RGB, Sorted) -> - D = distances(RGB,Sorted), - pos_for_smallest_distance(D,1,1000,-1). - -pos_for_smallest_distance([],_CurPos,_SmallestDist,Pos) -> Pos; -pos_for_smallest_distance([Dist|T],CurPos,SmallDist,_Pos) - when Dist < SmallDist -> - pos_for_smallest_distance(T,CurPos+1,Dist,CurPos); -pos_for_smallest_distance([_|T],CurPos,Smallest,Pos) -> - pos_for_smallest_distance(T,CurPos+1,Smallest,Pos). - -distances(_RGB,[]) -> - []; -distances({R,G,B},[{R2,G2,B2}|T]) -> - [lists:max([abs(R-R2),abs(G-G2),abs(B-B2)])|distances({R,G,B},T)]. - -get_option(Option, Options, Default) -> - case gs:assq(Option, Options) of - {value, Val} -> Val; - false -> Default - end. diff --git a/lib/gs/contribs/mandel/mandel.gif b/lib/gs/contribs/mandel/mandel.gif Binary files differdeleted file mode 100644 index 49ed1985cb..0000000000 --- a/lib/gs/contribs/mandel/mandel.gif +++ /dev/null diff --git a/lib/gs/contribs/mandel/mandel.html b/lib/gs/contribs/mandel/mandel.html deleted file mode 100644 index f69cfa3c6a..0000000000 --- a/lib/gs/contribs/mandel/mandel.html +++ /dev/null @@ -1,74 +0,0 @@ -<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN"> -<!-- - ``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 Utvecklings AB. - Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings - AB. All Rights Reserved.'' - - $Id$ ---> -<HTML> -<HEAD> - <TITLE></TITLE> - <META NAME="GENERATOR" CONTENT="Mozilla/3.01Gold (X11; I; SunOS 5.5.1 sun4m) [Netscape]"> -</HEAD> -<BODY> - -<H1>Distributed Mandelbrot program</H1> - -<P>Originally written i C++/rpc/lwp/interviews by Klas Eriksson.(1200 lines) -<BR> -Rewritten in Erlang by Klas Eriksson and Martin Björklund. </P> - -<P><A HREF="http://www.bush.edu/~nick/nick.html">What is the Mandelbrot -function?</A> </P> - -<H2>A small manual</H2> - -<UL> -<LI>Try starting erlang in distributed mode. The mandel program will use<BR> -all connected nodes for mandel calculations!</LI> - -<LI>Resizing the window will restart the calculation.</LI> - -<LI>Press left mouse button to zoom.</LI> -</UL> - -<P><TT>mandel:start(list of Option)</TT> can be used to give the program -different options.</P> - -<P><BR> -Available options are:</P> - -<UL> -<LI>{xmax,float()}</LI> - -<LI>{ymax,float()}</LI> - -<LI>{range,float()}|</LI> - -<LI>{maxiter,integer()}</LI> - -<LI>{window,integer()}</LI> - -<LI>{zoomstep,float()}</LI> - -<LI>{hosts,(list of string())|all_found_nodes}</LI> -</UL> - -<P><BR> -</P> - -</BODY> -</HTML> diff --git a/lib/gs/contribs/mandel/mandel.tool b/lib/gs/contribs/mandel/mandel.tool deleted file mode 100644 index b59941268e..0000000000 --- a/lib/gs/contribs/mandel/mandel.tool +++ /dev/null @@ -1,6 +0,0 @@ -{version,"0.1"}. -{{tool,"Mandel"}, - {start,{mandel,start,[]}}, - {icon,"mandel.gif"}, - {message,"Mandelbrot"}, - {html,"../mandel/mandel.html"}}. diff --git a/lib/gs/contribs/othello/Makefile b/lib/gs/contribs/othello/Makefile deleted file mode 100644 index 8a66e17ec5..0000000000 --- a/lib/gs/contribs/othello/Makefile +++ /dev/null @@ -1,101 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1996-2012. 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_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../../vsn.mk -VSN=$(GS_VSN) - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/gs-$(VSN)/contribs - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- - -MODULES= \ - othello \ - othello_adt \ - othello_board - -HRL_FILES= - -ERL_FILES= $(MODULES:%=%.erl) - -TARGET_FILES= $(MODULES:%=../ebin/%.$(EMULATOR)) $(TARGET_TOOLBOX_FILES) - -TOOLNAME = othello - -EXTRA_FILES= -TOOLBOX_FILES= $(TOOLNAME).tool $(TOOLNAME).gif -TARGET_TOOLBOX_FILES= $(TOOLBOX_FILES:%=$(EBIN)/%) -BITMAPS= priv/marker.bm priv/square.bm - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -ERL_COMPILE_FLAGS += - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -debug opt: $(TARGET_FILES) - -docs: - -clean: - rm -f $(TARGET_FILES) - rm -f core - -# ---------------------------------------------------- -# Special Build Targets -# ---------------------------------------------------- - -$(EBIN)/$(TOOLNAME).gif: $(TOOLNAME).gif - $(gen_verbose)rm -f $@ - $(V_at)cp $(TOOLNAME).gif $@ - -$(EBIN)/$(TOOLNAME).tool: $(TOOLNAME).tool - $(gen_verbose)rm -f $@ - $(V_at)cp $(TOOLNAME).tool $@ - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_spec: opt - $(INSTALL_DIR) "$(RELSYSDIR)/ebin" - $(INSTALL_DATA) $(TARGET_FILES) "$(RELSYSDIR)/ebin" - $(INSTALL_DIR) "$(RELSYSDIR)/othello" - $(INSTALL_DATA) $(ERL_FILES) $(EXTRA_FILES) "$(RELSYSDIR)/othello" - $(INSTALL_DIR) "$(RELSYSDIR)/othello/priv" - $(INSTALL_DATA) $(BITMAPS) $(TOOLBOX_FILES) "$(RELSYSDIR)/othello/priv" - -release_docs_spec: - diff --git a/lib/gs/contribs/othello/othello.erl b/lib/gs/contribs/othello/othello.erl deleted file mode 100644 index c6ad0a76ec..0000000000 --- a/lib/gs/contribs/othello/othello.erl +++ /dev/null @@ -1,237 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. 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(othello). --export([start/0,new_game/4,start1/5]). - - - -%%---------------------------------------------------------------------- -%% The Othello program now uses the gs graphical package instead of the -%% pxw package. See module othello_board for details -%% -%%---------------------------------------------------------------------- - - -start() -> othello_board:start(). - -new_game(Computer,Player,Depth,Init) -> - spawn_link(othello,start1,[self(),Computer,Player,Depth,Init]). - -start1(Win,Computer,Player,Depth,Init) -> - Board = othello_adt:new(t), - random:seed(), - init_display(Board,Win,Init), - play(Computer,Player,Board,Depth,Win,1). - -play(Computer,Player,Board,Depth,Win,NoDs) -> - tell_win(Win,Computer,Player), - case catch continue(Player,Board) of - {game_over,Result} -> - game_over(Board,Player,Result,Win); - {omit_draw,Player} -> - omit(Player,Win), - play(Computer,swap(Player),Board,Depth,Win,NoDs); - ok -> - Draw = choose_draw(Computer,Player,Board,Depth,Win,NoDs), - Win ! {self(),draw,Draw}, - Board1 = othello_adt:set(Draw,Player,Board), - display(Board1,Board,Win), - play(Computer,swap(Player),Board1,Depth,Win,NoDs+1) - end. - -continue(Player,Board) -> - Draws = game_over(Player,Board), - not_allowed(Draws,Player), - ok. - -choose_draw(Computer,Computer,Board,Depth,_Win,NoDs) -> % Depth > 0 !! - {Draw,_Value} = alpha_beta(Depth,Board,-11000,11000,Computer,NoDs), -% io:format('Choosen draw is {~w,~w} : (~w)~n', -% [othello_adt:col(Draw),othello_adt:row(Draw),Value]), -% io:format('=====================~n',[]), - Draw; -choose_draw(Computer,Player,Board,Depth,Win,NoDs) -> - receive - {Win,position,Draw} -> - flush(Win), - case othello_adt:is_draw(Draw,Player,Board) of - false -> - Win ! {self(),illegal_draw,Draw}, - choose_draw(Computer,Player,Board,Depth,Win,NoDs); - true -> - Draw - end - end. - -flush(Win) -> - receive - {Win,position,_} -> - flush(Win) - after 1 -> - true - end. - -tell_win(Win,Computer,Player) -> - Win ! {self(),player,Computer,Player}, - receive - {Win,go_on_play} -> true - end. - -alpha_beta(0,Board,_,_,Player,_) -> - {-1,othello_adt:evaluate_board(Player,Board)}; -alpha_beta(Depth,Board,Alpha,Beta,Player,NoDs) -> - case compute(Player,Board,NoDs) of - [] -> - Player1 = swap(Player), - case compute(Player1,Board,NoDs) of - [] -> - dead_lock(Board,Player); - PosDraws1 -> - choose(PosDraws1,Board,Depth-1,-Beta,-Alpha,-1, - Player1,NoDs) - end; - PosDraws -> - choose(PosDraws,Board,Depth-1,-Beta,-Alpha,-1,Player,NoDs) -% A = choose(PosDraws,Board,Depth-1,-Beta,-Alpha,-1,Player,NoDs), -% io:format('Alpha-Beta (~w) ==> ~w~n',[Depth,A]), -% A - end. - -choose([Draw|Draws],Board,Depth,Alpha,Beta,Record,Player,NoDs) -> - Player1 = swap(Player), - Board1 = othello_adt:set(Draw,Player,Board), -% io:format('Alpha <~w> Beta <~w> ~n',[Alpha,Beta]), - {_,Value} = alpha_beta(Depth,Board1,Alpha,Beta,Player1,NoDs+1), - Value1 = -Value, - cutoff(Draw,Value1,Depth,Alpha,Beta,Draws,Board,Record,Player,NoDs); -choose([],_,_,Alpha,_,Draw,_,_) -> - {Draw,Alpha}. - -cutoff(Draw,Value,_,_,Beta,_,_,_,_,_) when Value >= Beta -> - {Draw,Value}; -cutoff(Draw,Value,Depth,Alpha,Beta,Draws,Board,_,Player,NoDs) - when Alpha < Value, Value < Beta -> - choose(Draws,Board,Depth,Value,Beta,Draw,Player,NoDs); -cutoff(Draw,Value,Depth,Alpha,Beta,Draws,Board,Record,Player,NoDs) - when Value == Alpha, NoDs < 13 -> - choose(Draws,Board,Depth,Alpha,Beta,random_choice(Draw,Record), - Player,NoDs); -cutoff(_Draw,Value,Depth,Alpha,Beta,Draws,Board,Record,Player,NoDs) - when Value =< Alpha -> - choose(Draws,Board,Depth,Alpha,Beta,Record,Player,NoDs). - -compute(Player,Board,NoOfDraws) when NoOfDraws < 13 -> - case othello_adt:possible_draws(Player,Board,begin_play) of - [] -> - othello_adt:possible_draws(Player,Board,playing); - Draws -> - Draws - end; -compute(Player,Board,_) -> - othello_adt:possible_draws(Player,Board,playing). - -%%---------------------------------------------------------- -%% Randomly choose between two draws with the same value. -%%---------------------------------------------------------- - -random_choice(Draw,Draw1) -> - case random:uniform(2) of - 1 -> - Draw; - 2 -> - Draw1 - end. - -dead_lock(Board,Player) -> - case win_or_loose(Board,Player) of - 0 -> {-1,0}; - Value when Value > 0 -> {-1,10000}; - _ -> {-1,-10000} - end. - -win_or_loose(Board,Player) -> - Player1 = swap(Player), - othello_adt:pieces(Player,Board) - othello_adt:pieces(Player1,Board). - -game_over(Player,Board) -> - case othello_adt:possible_draws(Player,Board,playing) of - [] -> - Player1 = swap(Player), - case othello_adt:possible_draws(Player1,Board,playing) of - [] -> - throw({game_over,{{Player,othello_adt:pieces(Player,Board)}, - {Player1,othello_adt:pieces(Player1,Board)}}}); - _ -> - [] % Player`s Draws !! - end; - Draws -> - Draws - end. - -game_over(_Board,_Player,Result,Win) -> - Win ! {self(),game_over,white_res(Result),black_res(Result)}. - -white_res({{white,Res},_}) -> Res; -white_res({_,{white,Res}}) -> Res. - -black_res({{black,Res},_}) -> Res; -black_res({_,{black,Res}}) -> Res. - -not_allowed([],Player) -> - throw({omit_draw, Player}); -not_allowed(_,_Player) -> - ok. - -omit(Player,Win) -> - Win ! {self(),omit_draw,Player}, - receive - {Win,continue} -> - ok - end. - -init_display(_Board,_Win,first_time) -> - true; -init_display(Board,Win,_) -> - display(Board,Win). - -display(Board,Win) -> - All = othello_adt:all_pos(Board), - display1(All,Win), - Win ! {self(),score,othello_adt:pieces(white,Board), - othello_adt:pieces(black,Board)}. - -display(Board,OldB,Win) -> - Diff = othello_adt:diff(Board,OldB), - display1(Diff,Win), - Win ! {self(),score,othello_adt:pieces(white,Board), - othello_adt:pieces(black,Board)}. - -display1([{Pos,Colour}|Diff],Win) -> - Win ! {self(),new_mark,Pos,Colour}, - display1(Diff,Win); -display1(_,_) -> - true. - -swap(white) -> black; -swap(black) -> white. - - diff --git a/lib/gs/contribs/othello/othello.gif b/lib/gs/contribs/othello/othello.gif Binary files differdeleted file mode 100644 index 5970c50209..0000000000 --- a/lib/gs/contribs/othello/othello.gif +++ /dev/null diff --git a/lib/gs/contribs/othello/othello.tool b/lib/gs/contribs/othello/othello.tool deleted file mode 100644 index 47550a581d..0000000000 --- a/lib/gs/contribs/othello/othello.tool +++ /dev/null @@ -1,6 +0,0 @@ -{version,"0.1"}. -{{tool,"Othello"}, - {start,{othello,start,[]}}, - {icon,"othello.gif"}, - {message,"Othello - The Game"}, - {html,"http://www.armory.com/~iioa/othguide.html"}}. diff --git a/lib/gs/contribs/othello/othello_adt.erl b/lib/gs/contribs/othello/othello_adt.erl deleted file mode 100644 index e69c1c4d72..0000000000 --- a/lib/gs/contribs/othello/othello_adt.erl +++ /dev/null @@ -1,540 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2010. 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(othello_adt). --compile(export_all). -%%------------------------------------------------------- -%% Use three main states for the strategy: -%% -%% BeginPlay: Stay in the inner square as long as possible. -%% Use the possible_draws/3. -%% -%% MiddlePlay: Try to choose stable markers (?) -%% Use stable/3 -%% -%% EndPlay: Try to flip as many markers as possible -%% -%% The transition from Begin to Middle is obvious. From Middle -%% to End however, is can be discussed. -%%------------------------------------------------------- - -test(N,B) -> - X=new(B), - statistics(wall_clock), - test0(N,X), - {_,T} = statistics(wall_clock), - {time_was,T/N}. - - -test0(0,_) -> true; -test0(N,X) -> - possible_draws(black,X,begin_play), - test0(N-1,X). - -%%------------------------------------------------------- -%% new/1 - returns a new board -%% -%% Uses a tuple for storing the board -%%------------------------------------------------------- - -new(B) -> - Board = mk_board(B), - {ordsets:from_list([18,19,20,21,26,29,34,37,42,43,44,45]),Board}. - -mk_board(t) -> - Tup = list_to_tuple(gen_list(64,grey)), - Tup1 = setelement(28+1, Tup, white), - Tup2 = setelement(35+1, Tup1, white), - Tup3 = setelement(27+1, Tup2, black), - gen_score_board(), - setelement(36+1, Tup3, black). - -gen_list(0,_) -> []; -gen_list(I,Def) -> [Def|gen_list(I-1,Def)]. - -gen_score_board() -> put(score,list_to_tuple(gen_list(64,0))). - -%%------------------------------------------------------- -%% pos(Col,Row) - returns a position describing column -%% and row. -%% Col and Row have the range 1 - 8. -%%------------------------------------------------------- - -pos(Col,Row) -> ((Row - 1) bsl 3) + (Col - 1). - -%%------------------------------------------------------- -%% col(Pos) - returns the column of the Pos position -%%------------------------------------------------------- - -col(Pos) -> (Pos band 7) + 1. - -%%------------------------------------------------------- -%% row(Pos) - returns the row of the Pos position -%%------------------------------------------------------- - -row(Pos) -> (Pos bsr 3) + 1. - -%%------------------------------------------------------- -%% is_draw(Pos,Colour,Board) - returns true if Pos is a -%% correct draw. -%%------------------------------------------------------- - -is_draw(Pos,Colour,{Bset,Board}) -> - case ordsets:is_element(Pos,Bset) of - true -> - case catch is_good(Colour,Pos,Board) of - true -> - true; - _ -> - false - end; - _ -> - false - end. - -%%------------------------------------------------------- -%% set(Pos,Colour,Board) - returns an updated board -%%------------------------------------------------------- - -set(Pos,Colour,{Bset,Board}) -> - case ordsets:is_element(Pos,Bset) of - true -> - NewBoard = setelement(Pos+1,Board,Colour), - Empty = empty_neighbour(Pos,NewBoard), - NewBset = ordsets:union(Empty,ordsets:del_element(Pos,Bset)), - turn(Colour,Pos,{NewBset,NewBoard}); - _ -> - {error,invalid_position} - end. - -empty_neighbour(Pos,Board) -> - ordsets:from_list(empty_neighbour(Pos,Board,deltas())). - -empty_neighbour(_,_,[]) -> []; -empty_neighbour(Pos,Board,[H|T]) -> - case is_empty(Pos+H,dir(Pos,H),Board) of - true -> [Pos+H|empty_neighbour(Pos,Board,T)]; - _ -> empty_neighbour(Pos,Board,T) - end. - -is_empty(_,false,_) -> false; -is_empty(X,_,_Board) when X<0 -> false; -is_empty(X,_,_Board) when X>63 -> false; -is_empty(X,_,Board) -> - case element(X+1,Board) of - grey -> true; % Empty - _ -> false - end. - -%%------------------------------------------------------- -%% get(Pos,Board) - returns the contents in Pos -%%------------------------------------------------------- - -get(Pos,{_Bset,Board}) -> element(Pos+1,Board). - -%%------------------------------------------------------- -%% pieces(Colour,Board) - returns the number of Colour -%% pieces. -%%------------------------------------------------------- - -pieces(Colour,{_Bset,Board}) -> - pieces(Colour,Board,0,0). - -pieces(Colour,Board,Pos,Count) when Pos < 64 -> - case element(Pos+1,Board) of - Colour -> - pieces(Colour,Board,Pos+1,Count+1); - _ -> - pieces(Colour,Board,Pos+1,Count) - end; -pieces(_,_,_,Count) -> - Count. - -%%------------------------------------------------------- -%% possible_draws(Colour, Board, State) -%% -%% Returns a list of possible draws regarding the current -%% strategy state. -%%------------------------------------------------------- - -possible_draws(Colour,{Bset,Board},begin_play) -> - Dset = ordsets:intersection(Bset,inner_square()), - possible_draws_0(Colour,Dset,Board); -possible_draws(Colour,{Bset,Board},_) -> - possible_draws_0(Colour,Bset,Board). - -possible_draws(Colour,{Bset,Board}) -> - possible_draws_0(Colour,Bset,Board). - -possible_draws_0(_,[],_) -> []; -possible_draws_0(Colour,[H|T],Board) -> - case catch is_good(Colour,H,Board) of - true -> [H|possible_draws_0(Colour,T,Board)]; - false -> possible_draws_0(Colour,T,Board) - end. - - -%%------------------------------------------------------- -%% evaluate_board(Colour,Board) - returns the value of -%% the board from Colours -%% point of view. -%%------------------------------------------------------- - -evaluate_board(Colour,{_Bset,Board}) -> - Score = get(score), % Initialized (zeroed) score board !! - Colour1 = swap(Colour), - Score1 = eval_board(Colour,Colour1,Score,Board,0), - Score2 = cnt_corner(0,Score1,Board,Colour,Colour1), - Score3 = cnt_corner(7,Score2,Board,Colour,Colour1), - Score4 = cnt_corner(56,Score3,Board,Colour,Colour1), - Score5 = cnt_corner(63,Score4,Board,Colour,Colour1), - count(Score5,0). -% A = count(Score5,0), -% io:format('Score = ~w~n',[A]), -% A. - -eval_board(MyCol,OtCol,Score,Board,Pos) when Pos < 64 -> - case element(Pos+1,Board) of - MyCol -> - Score1 = setelement(Pos+1,Score,score(Pos)), - eval_board(MyCol,OtCol,Score1,Board,Pos+1); - OtCol -> - Score1 = setelement(Pos+1,Score,-score(Pos)), - eval_board(MyCol,OtCol,Score1,Board,Pos+1); - _ -> - eval_board(MyCol,OtCol,Score,Board,Pos+1) - end; -eval_board(_,_,Score,_,_) -> - Score. - -cnt_corner(Corner,Score,Board,MyCol,OtCol) -> - case element(Corner+1,Board) of - MyCol -> - cnt_corn(Corner,setelement(Corner+1,Score,50), - Board,50,MyCol); - OtCol -> - cnt_corn(Corner,setelement(Corner+1,Score,-50), - Board,-50,OtCol); - _ -> - Score - end. - -cnt_corn(0,Score,Board,Value,Colour) -> - Score1 = cnt_corn(0,1,8,Score,Board,Value,Colour), - cnt_corn(0,8,1,Score1,Board,Value,Colour); -cnt_corn(7,Score,Board,Value,Colour) -> - Score1 = cnt_corn(7,-1,8,Score,Board,Value,Colour), - cnt_corn(7,8,-1,Score1,Board,Value,Colour); -cnt_corn(56,Score,Board,Value,Colour) -> - Score1 = cnt_corn(56,1,-8,Score,Board,Value,Colour), - cnt_corn(56,-8,1,Score1,Board,Value,Colour); -cnt_corn(63,Score,Board,Value,Colour) -> - Score1 = cnt_corn(63,-1,-8,Score,Board,Value,Colour), - cnt_corn(63,-8,-1,Score1,Board,Value,Colour). - -cnt_corn(Pos,Dir,LineDir,Score,Board,Value,Colour) -> - case dir(Pos,Dir) of - Dir -> - NextEdge = Pos+Dir, - case element(NextEdge+1,Board) of - Colour -> - Score1 = setelement(NextEdge+1,Score,Value), - Score2 = cnt_line(NextEdge,LineDir,Score1,Board, - Colour,Value), - cnt_corn(NextEdge,Dir,LineDir,Score2,Board,Value,Colour); - _ -> - Score - end; - _ -> - Score - end. - -cnt_line(Pos,Dir,Score,Board,Colour,Value) -> - case dir(Pos,Dir) of - Dir -> - OnLinePos = Pos+Dir, - case element(OnLinePos+1,Board) of - Colour -> - Score1 = setelement(OnLinePos+1,Score,Value), - cnt_line(OnLinePos,Dir,Score1,Board,Colour,Value); - _ -> - Score - end; - _ -> - Score - end. - -count(Score,Pos) when Pos < 64 -> - element(Pos+1,Score) + count(Score,Pos+1); -count(_,_) -> - 0. - -swap(white) -> black; -swap(black) -> white. - -%%------------------------------------------------------- -%% stable(Colour,Pos,Board) - returns a value 0-8 -%% -%% A high value is regarded as more stable than a lower one. -%% The stability means how many "friendly" neighbours there -%% are, i.e markers of the same colour. Neighbours positions -%% outside the board are regarded as friendly. -%%------------------------------------------------------- - -stable(Colour,Pos,{_,Board}) -> - stable(deltas(),Colour,Pos,Board). - -stable([],_,_,_) -> 0; -stable([H|T],Colour,Pos,Board) -> - stable_val(Colour,Pos,H,Board) + stable(T,Colour,Pos,Board). - -stable_val(_,H,D,_) when H+D<0 -> 1; -stable_val(_,H,D,_) when H+D>63 -> 1; -stable_val(black,H,D,Board) -> - case element((H+D)+1,Board) of - black -> 1; - _ -> 0 - end; -stable_val(white,H,D,Board) -> - case element((H+D)+1,Board) of - white -> 1; - _ -> 0 - end. - -%%------------------------------------------------------- -%% diff(Board,OldBoard) - return a list of the positions -%% with changed pieces. -%% [{Pos1,Colour1},...] -%%------------------------------------------------------- - -diff(Board,OldBoard) -> diff(0,Board,OldBoard). - -diff(Pos,Board,OldBoard) when Pos < 64 -> - OldP = get(Pos,OldBoard), - case get(Pos,Board) of - OldP -> - diff(Pos+1,Board,OldBoard); - NewP -> - [{Pos,NewP}|diff(Pos+1,Board,OldBoard)] - end; -diff(_,_,_) -> - []. - -%%------------------------------------------------------- -%% all_pos(Board) - return a list of the positions colour. -%% [{Pos1,Colour1},...] -%%------------------------------------------------------- - -all_pos(Board) -> all_pos(0,Board). - -all_pos(Pos,Board) when Pos < 64 -> - [{Pos,get(Pos,Board)}|all_pos(Pos+1,Board)]; -all_pos(_,_) -> - []. - -%%------------------------------------------------------- -%% Internal stuff -%%------------------------------------------------------- - -deltas() -> [9,8,7,1,-1,-7,-8,-9]. - -inner_square() -> - [18,19,20,21,26,27,28,29,34,35,36,37,42,43,44,45]. % Is already an ordset - % Save list traversing. -% ordsets:list_to_set([18,19,20,21,26,27,28,29,34,35,36,37,42,43,44,45]). - -inv(black) -> white; -inv(white) -> black. - -is_good(Colour,H,Board) -> - is_good_0(Colour,H,dir(H,-9),Board), - is_good_0(Colour,H,dir(H,-8),Board), - is_good_0(Colour,H,dir(H,-7),Board), - is_good_0(Colour,H,dir(H,-1),Board), - is_good_0(Colour,H,dir(H,1),Board), - is_good_0(Colour,H,dir(H,7),Board), - is_good_0(Colour,H,dir(H,8),Board), - is_good_0(Colour,H,dir(H,9),Board), - false. - -is_good_0(_,_,false,_) -> false; -is_good_0(_,H,D,_) when is_integer(H), is_integer(D), H+D<0 -> false; -is_good_0(_,H,D,_) when is_integer(H), is_integer(D), H+D>63 -> false; -is_good_0(black,H,D,Board) when is_integer(H), is_integer(D) -> - case element((H+D)+1,Board) of - white -> is_good_1(black,H+D,dir(H+D,D),Board); - _ -> false - end; -is_good_0(white,H,D,Board) when is_integer(H), is_integer(D) -> - case element((H+D)+1,Board) of - black -> is_good_1(white,H+D,dir(H+D,D),Board); - _ -> false - end. - -is_good_1(_,_,false,_) -> false; -is_good_1(_,H,D,_) when is_integer(H), is_integer(D), H+D<0 -> false; -is_good_1(_,H,D,_) when is_integer(H), is_integer(D), H+D>63 -> false; -is_good_1(black,H,D,Board) when is_integer(H), is_integer(D) -> - case element((H+D)+1,Board) of - white -> is_good_1(black,H+D,dir(H+D,D),Board); - black -> throw(true); - _ -> false - end; -is_good_1(white,H,D,Board) when is_integer(H), is_integer(D) -> - case element((H+D)+1,Board) of - black -> is_good_1(white,H+D,dir(H+D,D),Board); - white -> throw(true); - _ -> false - end. - -%%------------------------------------------------------- -%% turn(Colour,Draw,Board) - returns an updated board -%% turn all possible pieces -%% on the board -%% Neighbours are not changed !! -%%------------------------------------------------------- - -turn(Colour,Draw,{Bset,Board}) -> - {Bset,turn(Colour,Draw,-9, - turn(Colour,Draw,-8, - turn(Colour,Draw,-7, - turn(Colour,Draw,-1, - turn(Colour,Draw,1, - turn(Colour,Draw,7, - turn(Colour,Draw,8, - turn(Colour,Draw,9,Board))))))))}. - -turn(Colour,H,D,Board) -> - case catch is_good_0(Colour,H,dir(H,D),Board) of - true -> - turn_0(Colour,H,D,Board); - false -> - Board - end. - -turn_0(_,H,D,B) when is_integer(H), is_integer(D), H+D<0 -> B; -turn_0(_,H,D,B) when is_integer(H), is_integer(D), H+D>63 -> B; -turn_0(black,H,D,Board) when is_integer(H), is_integer(D) -> - E = H+D, - case element(E+1,Board) of - white -> turn_0(black,H+D,D,swap(black,E,Board)); - _ -> Board - end; -turn_0(white,H,D,Board) when is_integer(H), is_integer(D) -> - E = H+D, - case element(E+1,Board) of - black -> turn_0(white,H+D,D,swap(white,E,Board)); - _ -> Board - end. - -%%------------------------------------------------------- -%% swap(Colour,Pos,Board) - returns an updated board -%% turn a piece on the board -%% Neighbours are not changed !! -%%------------------------------------------------------- - -swap(Colour,Pos,Board) when is_integer(Pos) -> - setelement(Pos+1,Board,Colour). - -score(Pos) -> score1({col(Pos),row(Pos)}). - -score1({Column,1}) when Column >= 3, Column =< 6 -> 20; -score1({Column,8}) when Column >= 3, Column =< 6 -> 20; -score1({1,Line}) when Line >= 3, Line =< 6 -> 20; -score1({8,Line}) when Line >= 3, Line =< 6 -> 20; -score1({Column,2}) when Column >= 3, Column =< 6 -> -7; -score1({Column,7}) when Column >= 3, Column =< 6 -> -7; -score1({2,Line}) when Line >= 3, Line =< 6 -> -7; -score1({7,Line}) when Line >= 3, Line =< 6 -> -7; -score1({Column,Line}) when Column >= 3, Column =< 6, - Line >= 3, Line =< 6 -> 1; -score1({1,1}) -> 100; -score1({1,8}) -> 100; -score1({8,1}) -> 100; -score1({8,8}) -> 100; -score1({2,1}) -> -30; -score1({7,1}) -> -30; -score1({1,2}) -> -30; -score1({8,2}) -> -30; -score1({1,7}) -> -30; -score1({8,7}) -> -30; -score1({2,8}) -> -30; -score1({7,8}) -> -30; -score1({2,2}) -> -50; -score1({7,2}) -> -50; -score1({2,7}) -> -50; -score1({7,7}) -> -50. - -%%------------------------------------------------------- -%% dir(Pos,Dir) - return Dir if allowed direction at Pos. -%% else return false. -%%------------------------------------------------------- - -dir(0,1) -> 1; % {1,1} -dir(0,8) -> 8; -dir(0,9) -> 9; -dir(0,_) -> false; - -dir(7,-1) -> -1; % {8,1} -dir(7,7) -> 7; -dir(7,8) -> 8; -dir(7,_) -> false; - -dir(56,-8) -> -8; % {1,8} -dir(56,-7) -> -7; -dir(56,1) -> 1; -dir(56,_) -> false; - -dir(63,-9) -> -9; % {8,8} -dir(63,-8) -> -8; -dir(63,-1) -> -1; -dir(63,_) -> false; - -dir(Pos,-1) when (Pos bsr 3) == 0 -> -1; % {_,1} -dir(Pos,1) when (Pos bsr 3) == 0 -> 1; -dir(Pos,7) when (Pos bsr 3) == 0 -> 7; -dir(Pos,8) when (Pos bsr 3) == 0 -> 8; -dir(Pos,9) when (Pos bsr 3) == 0 -> 9; -dir(Pos,_) when (Pos bsr 3) == 0 -> false; - -dir(Pos,-9) when (Pos bsr 3) == 7 -> -9; % {_,8} -dir(Pos,-8) when (Pos bsr 3) == 7 -> -8; -dir(Pos,-7) when (Pos bsr 3) == 7 -> -7; -dir(Pos,-1) when (Pos bsr 3) == 7 -> -1; -dir(Pos,1) when (Pos bsr 3) == 7 -> 1; -dir(Pos,_) when (Pos bsr 3) == 7 -> false; - -dir(Pos,-8) when (Pos band 7) == 0 -> -8; % {1,_} -dir(Pos,-7) when (Pos band 7) == 0 -> -7; -dir(Pos,1) when (Pos band 7) == 0 -> 1; -dir(Pos,8) when (Pos band 7) == 0 -> 8; -dir(Pos,9) when (Pos band 7) == 0 -> 9; -dir(Pos,_) when (Pos band 7) == 0 -> false; - -dir(Pos,-9) when (Pos band 7) == 7 -> -9; % {8,_} -dir(Pos,-8) when (Pos band 7) == 7 -> -8; -dir(Pos,-1) when (Pos band 7) == 7 -> -1; -dir(Pos,7) when (Pos band 7) == 7 -> 7; -dir(Pos,8) when (Pos band 7) == 7 -> 8; -dir(Pos,_) when (Pos band 7) == 7 -> false; - -dir(_Pos,Dir) -> Dir. - diff --git a/lib/gs/contribs/othello/othello_board.erl b/lib/gs/contribs/othello/othello_board.erl deleted file mode 100644 index cc055b1fa1..0000000000 --- a/lib/gs/contribs/othello/othello_board.erl +++ /dev/null @@ -1,649 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2012. 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(othello_board). --compile([{nowarn_deprecated_function,{gs,config,2}}, - {nowarn_deprecated_function,{gs,create,3}}, - {nowarn_deprecated_function,{gs,create,4}}, - {nowarn_deprecated_function,{gs,destroy,1}}, - {nowarn_deprecated_function,{gs,start,0}}]). - --export([start/0,stop/0,init/0]). - - -%%---------------------------------------------------------------------- -%% The Othello program now uses the gs graphical package instead of the -%% pxw package. -%% -%% Differences are, explanation why and source of change in parenthesis: -%% -%% - Buttons looks different (gs feature) -%% - The black box around "Black to draw" have been removed. (me) -%% - The Colour and Level menues have been moved directly down to the -%% 'Status' box. (usability update, my addition) -%% - The mouse pointer does not change into a watch when the computer -%% is thinking (not supported in gs) -%% - Buttons does not flash when being beeped. (not supported in gs) -%% -%% -%% /Peter -%% -%%---------------------------------------------------------------------- - - --define(BGCOL,forestgreen). - -start() -> - spawn(othello_board,init,[]). - -stop() -> - ok. - -%% This is not an application so we don't have their way of knowing -%% a private data directory where the GIF files are located (this directory). -%% We can find GS and makes it relative from there /kgb - --define(BitmapPath,"../contribs/othello/priv"). - -setup_path() -> - GsPrivDir = code:priv_dir(gs), - Path = filename:join(GsPrivDir,?BitmapPath), - put(path,Path). - -path() -> get(path). - - - -%% -%% The button area are the Quit, Rules buttons at the top of the window. -%% The Status area is the black and white scores level and colour etc -%% inbetween the buttons and the othello board. -%% The board is the 8x8 board where othello battles are fought. -%% -init() -> - process_flag(trap_exit,true), - setup_path(), - S = gs:start(), - put(windowroot,S), % Ugly global store - - %% Shell coordinates - W = 496, - H = 636, - - %% Fix top window - Shell = gs:create(window, S, [{title,"Othello"}, - {width, W},{height, H}]), - - - %% Setup window contents - - setup_buttons(Shell,0,0,W,40), % Fix Menubar - setup_status_box(Shell,0,40,W,100), % Fix Status area - setup_board(Shell,0,140,496,496), % Combat board - - GamePid = othello:new_game(white,black,1,first_time), - - %% Default settings - Options = {white,black,1}, - %%Wids = {Status,B,W,Dr,Le,Co}, - Wids = {change,this,at,later,stage,ponto}, - write_options(Options,Wids), - - gs:config(Shell, {map, true}), %Make win visible - - loop(computer,GamePid,Shell,Wids,Options). - - - - - - -loop(User,GamePid,Shell,Wids,Options) -> - receive - {gs,ButtId, click,_ButtId1,[Button]} -> - GamePid1 = but_pressed(Button,ButtId,User,GamePid,Shell, - Wids,Options), - loop(User,GamePid1,Shell,Wids,Options); - - {gs,_, click,_,[MenuItem,_MenuIndex]} -> - Ops = menu_selected(MenuItem,User,GamePid,Wids,Options), - loop(User,GamePid,Shell,Wids,Ops); - - {'EXIT',GamePid,_} -> - loop(User,null,Shell,Wids,Options); - - {'EXIT',_,_} -> - loop(User,GamePid,Shell,Wids,Options); - - GameMsg -> - game_msg(GameMsg,User,GamePid,Shell,Wids,Options) - end. - -but_pressed("Quit",_ButtId,_User,_GamePid,_Shell,_Wids,_Op) -> - stop(), - exit(quit); -but_pressed("Rules",_ButtId,_User,GamePid,_Shell,_Wids,_Op) -> - io:format("No rules, do as you wish~n",[]), - GamePid; -but_pressed("Help",_ButtId,_User,GamePid,_Shell,_Wids,_Op) -> - io:format("Othello game~n",[]), - io:format("------------~n",[]), - io:format(" Put markers by clicking in squares~n",[]), - io:format(" Change level by clicking on it~n",[]), - io:format(" Change colour by clicking on it~n",[]), - io:format("~n",[]), - GamePid; -but_pressed("Newgame",_ButtId,_User,GamePid,_Shell,Wids,Options) -> - new_game(GamePid,Wids,Options); -but_pressed([],ButtId,User,GamePid,_Shell,_Wids,_Op) - when is_pid(GamePid),User == player -> - [C,R] = atom_to_list(ButtId), - GamePid ! {self(),position,othello_adt:pos(C-96,translate(R-48))}, - GamePid; -but_pressed([],ButtId,_User,GamePid,_Shell,_Wids,_Op) -> - [C,R] = atom_to_list(ButtId), - beep(othello_adt:pos(C-96,translate(R-48))), - GamePid; -but_pressed(Button,ButtId,_User,GamePid,_Shell,_Wids,_Op) -> - io:format('Not implemented button pressed ~p, ~p!!!~n',[ButtId,Button]), - GamePid. - -menu_selected("Black",_User,_GamePid,Wids,Options) -> - Op0 = setelement(1,Options,white), - Op1 = setelement(2,Op0,white), - write_options(Op1,Wids), - Op1; -menu_selected("White",_User,_GamePid,Wids,Options) -> - Op0 = setelement(1,Options,black), - Op1 = setelement(2,Op0,black), - write_options(Op1,Wids), - Op1; -menu_selected("Black (begin)",_User,_GamePid,Wids,Options) -> - Op0 = setelement(1,Options,white), - Op1 = setelement(2,Op0,black), - write_options(Op1,Wids), - Op1; -menu_selected("White (begin)",_User,_GamePid,Wids,Options) -> - Op0 = setelement(1,Options,black), - Op1 = setelement(2,Op0,white), - write_options(Op1,Wids), - Op1; -menu_selected("Beginner",_User,_GamePid,Wids,Options) -> - Op1 = setelement(3,Options,1), - write_options(Op1,Wids), - Op1; -menu_selected("Intermediate",_User,_GamePid,Wids,Options) -> - Op1 = setelement(3,Options,2), - write_options(Op1,Wids), - Op1; -menu_selected("Advanced",_User,_GamePid,Wids,Options) -> - Op1 = setelement(3,Options,3), - write_options(Op1,Wids), - Op1; -menu_selected("Expert",_User,_GamePid,Wids,Options) -> - Op1 = setelement(3,Options,4), - write_options(Op1,Wids), - Op1; -menu_selected(What,_User,_GamePid,_Wids,Options) -> - io:format('Menu item not implemented <~s>~n',[What]), - Options. - -game_msg(Msg,User,GamePid,Shell,Wids,Options) -> - case Msg of - {GamePid,new_mark,Pos,Colour} -> - new_mark(Pos,Colour), - loop(User,GamePid,Shell,Wids,Options); - - {GamePid,illegal_draw,Draw} -> - beep(Draw), - loop(User,GamePid,Shell,Wids,Options); - - {GamePid,player,Computer,Computer} -> - show_player(element(1,Wids),Computer), - cursor("watch"), - GamePid ! {self(),go_on_play}, - loop(computer,GamePid,Shell,Wids,Options); - - {GamePid,player,_Computer,Player} -> - show_player(element(1,Wids),Player), - cursor("top_left_arrow"), - GamePid ! {self(),go_on_play}, - loop(player,GamePid,Shell,Wids,Options); - - {GamePid,omit_draw,Player} -> - omit_draw(GamePid,Player), - loop(User,GamePid,Shell,Wids,Options); - - {GamePid,score,WhiteRes,BlackRes} -> - write_score(Wids,WhiteRes,BlackRes), - loop(User,GamePid,Shell,Wids,Options); - - {GamePid,draw,Draw} -> - write_draw(Wids,Draw), - loop(User,GamePid,Shell,Wids,Options); - - {GamePid,game_over,WhiteRes,BlackRes} -> - game_over(WhiteRes,BlackRes), - loop(User,GamePid,Shell,Wids,Options); - - What -> - io:format('game_msg received: ~w~n',[What]), - loop(User,GamePid,Shell,Wids,Options) - end. - - -new_game(GamePid,Wids,Options) when is_pid(GamePid) -> - exit(GamePid,kill), - new_game(Wids,Options); -new_game(_,Wids,Options) -> - new_game(Wids,Options). - -new_game(_Wids,Options) -> - label("",lastdraw), - Computer = element(1,Options), - Start = element(2,Options), - Depth = element(3,Options), - othello:new_game(Computer,Start,Depth,restart). - -new_mark(Pos,Colour) -> - Col = othello_adt:col(Pos), - Row = othello_adt:row(Pos), - Name = [Col+96,translate(Row)+48], - Button = get(Name), - butbit(Button,Colour). - -beep(Draw) -> - Col = othello_adt:col(Draw), - Row = othello_adt:row(Draw), - Name = [Col+96,translate(Row)+48], - Button = get(Name), - bell(Button). - -show_player(_Status,white) -> - label("White to draw",todraw); -show_player(_Status,black) -> - label("Black to draw",todraw). - -write_score(_Wids,WhiteRes,BlackRes) -> - label(integer_to_list(BlackRes),bscore), - label(integer_to_list(WhiteRes),wscore). - -write_draw(_Wids,Draw) -> - Col = othello_adt:col(Draw), - Row = othello_adt:row(Draw), - label(lists:flatten(io_lib:format('{~w,~w}',[Col,Row])), lastdraw). - -write_options(Options,Wids) -> - write_colour(Options,Wids), - write_level(Options,Wids). - -write_colour(Options,Wids) -> - write_colour(element(1,Options),element(2,Options),Wids). - -write_colour(black,white,_Wids) -> label("White (begin)",colour); -write_colour(black,black,_Wids) -> label("White",colour); -write_colour(white,black,_Wids) -> label("Black (begin)",colour); -write_colour(white,white,_Wids) -> label("Black",colour). - -write_level(Options,_Wids) -> - case element(3,Options) of - 1 -> label("Beginner",level); - 2 -> label("Intermediate",level); - 3 -> label("Advanced",level); - 4 -> label("Expert",level) - end. - -cursor(_What) -> - done. -%cursor(What) -> cursor(get(),What). - -%cursor([{[C,R],Button}|Buts],What) -> -% set_widget(Button,"cursor",What), -% cursor(Buts,What); -%cursor([_|Buts],What) -> -% cursor(Buts,What); -%cursor([],_) -> -% true. - -translate(1) -> 8; -translate(2) -> 7; -translate(3) -> 6; -translate(4) -> 5; -translate(5) -> 4; -translate(6) -> 3; -translate(7) -> 2; -translate(8) -> 1. - -bitmap(grey) -> bitmap_path("square.bm"); -bitmap(black) -> bitmap_path("marker.bm"); -bitmap(white) -> bitmap_path("marker.bm"). - -bitmap_path(Bitmap) -> - filename:join(path(),Bitmap). - -xy_position([[Letter,Digit],_,_]) -> - LettPos = Letter - 97, - X = LettPos*60 , - Y = (8 - list_to_integer([Digit])) * 60, - {X+6,Y+6}; -xy_position(X) -> - io:format("xy_position: ~w~n",[{error,X}]). - - -board() -> - [["a1",grey,nil], - ["b1",grey,nil], - ["c1",grey,nil], - ["d1",grey,nil], - ["e1",grey,nil], - ["f1",grey,nil], - ["g1",grey,nil], - ["h1",grey,nil], - - ["a2",grey,nil], - ["b2",grey,nil], - ["c2",grey,nil], - ["d2",grey,nil], - ["e2",grey,nil], - ["f2",grey,nil], - ["g2",grey,nil], - ["h2",grey,nil], - - ["a3",grey,nil], - ["b3",grey,nil], - ["c3",grey,nil], - ["d3",grey,nil], - ["e3",grey,nil], - ["f3",grey,nil], - ["g3",grey,nil], - ["h3",grey,nil], - - ["a4",grey,nil], - ["b4",grey,nil], - ["c4",grey,nil], - ["d4",white,nil], - ["e4",black,nil], - ["f4",grey,nil], - ["g4",grey,nil], - ["h4",grey,nil], - - ["a5",grey,nil], - ["b5",grey,nil], - ["c5",grey,nil], - ["d5",black,nil], - ["e5",white,nil], - ["f5",grey,nil], - ["g5",grey,nil], - ["h5",grey,nil], - - ["a6",grey,nil], - ["b6",grey,nil], - ["c6",grey,nil], - ["d6",grey,nil], - ["e6",grey,nil], - ["f6",grey,nil], - ["g6",grey,nil], - ["h6",grey,nil], - - ["a7",grey,nil], - ["b7",grey,nil], - ["c7",grey,nil], - ["d7",grey,nil], - ["e7",grey,nil], - ["f7",grey,nil], - ["g7",grey,nil], - ["h7",grey,nil], - - ["a8",grey,nil], - ["b8",grey,nil], - ["c8",grey,nil], - ["d8",grey,nil], - ["e8",grey,nil], - ["f8",grey,nil], - ["g8",grey,nil], - ["h8",grey,nil]]. - - -omit_draw(GamePid,Player) -> -% %% Find mouse coords first -% %% This was not possible in gs - - W = 200, H = 100, Root = get(windowroot), - Box = gs:create(window, Root, [{title,"OMIT"}, {width, W},{height, H}]), - - mk_label_c(lists:flatten(io_lib:format('~w has to omit draw !',[Player])), - Box, W, 10), - - mk_button_c("Ok", Box, W, H-40, 80, 30), - - gs:config(Box, {map, true}), %Make win visible - - receive - {gs,_, click,_,["Ok"]} -> - gs:destroy(Box), - GamePid ! {self(),continue} - end. - -game_over(WhiteRes,BlackRes) -> -% %% Find mouse coords first -% %% This was not possible in gs - - W = 200, H = 160, - Root = get(windowroot), - Box = gs:create(window, Root, [{title,"GAME OVER"}, - {width, W},{height, H}]), - - mk_label_c("GAME OVER", Box, W, 10), - - mk_label_c(lists:flatten(io_lib:format('White score: ~w',[WhiteRes])), - Box,W,40), - mk_label_c(lists:flatten(io_lib:format('Black score: ~w',[BlackRes])), - Box,W,70), - - mk_button_c("Ok", Box, W, H-40, 80, 30), - - gs:config(Box, {map, true}), %Make win visible - - receive - {gs,_, click,_,["Ok"]} -> - gs:destroy(Box) - end. - - - -%% ---------------------------------------------------------------- -%% Library functions. -%% ---------------------------------------------------------------- - -bell(Widget) -> - %% gs does not support bells, - Widget. - -label(Text,Label) -> - gs:config(Label,[{label,{text,Text}}]). - -%% mk_label in centered version -mk_label_c(Label,Parent,Width,Y) -> - W = 8*length(Label), - X = trunc((Width-W)/2), - gs:create(label,Parent,[{width,W}, {height, 20}, {x,X}, {y,Y}, - {label, {text, Label}}]). - - - - -setup_buttons(Shell,X,Y,W,H) -> - ButBox = gs:create(frame, Shell,[{x,X}, {y,Y},{bg,white}, - {width,W}, {height,H}]), - C = gs:create(canvas,ButBox,[{x,X}, {y,Y}, {width, W}, {height, H}, - {bg,white}]), - gs:create(line, C, [{coords, [{0,H-1},{W,H-1}]}]), - - - mk_button("Quit",ButBox, 10, 10, 70, 20), - mk_button("Rules",ButBox, 80, 10, 70, 20), - mk_button("Newgame",ButBox, 150, 10, 70, 20), - mk_button("Help",ButBox, 220, 10, 70, 20), -%% mk_button("Level",ButBox, 290, 10, 70, 20), - - done. - - - - - -%%---------------------------------------- -%% Sets up the middle window w. all the status info in. -%% The labels are given names: -%% bscore, wscore, lastdraw, todraw, level and colour to simplify -%% their frequent setting -%% -setup_status_box(Shell,X,Y,W,H) -> - F = gs:create(frame, Shell,[{x,X}, {y,Y}, - {width,W}, {height,H},{bg,white}]), - C = gs:create(canvas,F,[{x,0}, {y,0}, {width, W}, {height, H},{bg,white}]), - gs:create(line, C, [{coords, [{0,H-1},{W,H-1}]}]), - - %% Left side - gs:create(label,F,[{align,w},{x,10}, {y,5}, {width, 100}, - {label,{text, "Black score:"}},{bg,white}]), - gs:create(label,bscore,F,[{align,w},{x,110}, {y,5}, {width, 40}, - {label,{text, "2"}},{bg,white}]), - gs:create(label,F,[{align,w},{x,10}, {y,35}, {width, 100}, - {label,{text, "White score:"}},{bg,white}]), - gs:create(label,wscore,F,[{align,w},{x,110}, {y,35}, {width, 40}, - {label,{text, "2"}},{bg,white}]), - gs:create(label,F,[{align,w},{x,10}, {y,65}, {width, 100}, - {label,{text, "Last draw:"}},{bg,white}]), - gs:create(label,lastdraw,F,[{align,w},{x,110}, {y,65}, {width, 40}, - {label,{text, ""}},{bg,white}]), - - - %% Right side - X2 = trunc(W/2)+10, - gs:create(label,todraw,F,[{align,w},{x,X2}, {y,5}, {width, 100}, - {label,{text, "Black to draw:"}},{bg,white}]), - - gs:create(label,F,[{align,w},{x,X2}, {y,35}, {width, 80}, - {label,{text, "Level:"}},{bg,white}]), - setup_level_menu(F,X2+80,35), - -%% gs:create(label,level,F,[{align,w},{x,X2+80}, {y,35}, {width, 130}, -%% {label,{text, "Intermediate"}},{bg,white}]), - gs:create(label,F,[{align,w},{x,X2}, {y,65}, {width, 80}, - {label,{text, "Colour:"}},{bg,white}]), - setup_col_menu(F,X2+80,65), - -%% gs:create(label,colour,F,[{align,w},{x,X2+80}, {y,65}, {width, 120}, -%% {label,{text, "black (begin)"}},{bg,white}]), - - done. - - -setup_col_menu(P,X,Y) -> - MB = gs:create(menubutton,colour,P, - [{x,X}, {y,Y}, {bw,3}, - %%{width,W}, {height,H}, - {align,w}, {bg,white}, - {relief, raised}, - {activefg,white}, {activebg,black}, - {label, {text,"Colours"}}]), - - M = gs:create(menu,MB,[]), - gs:create(menuitem,M,[{label,{text,"Black (begin)"}}]), - gs:create(menuitem,M,[{label,{text,"Black"}}]), - gs:create(menuitem,M,[{label,{text,"White (begin)"}}]), - gs:create(menuitem,M,[{label,{text,"White"}}]), - done. - -setup_level_menu(P,X,Y) -> - MB = gs:create(menubutton,level,P, - [{x,X}, {y,Y}, - %%{width,W}, {height,H}, - {relief, raised}, - {activefg,white}, {activebg,black}, - {align,w}, {bg,white}, - {label, {text,"Colours"}}]), - - M = gs:create(menu,MB,[]), - gs:create(menuitem,M,[{label,{text,"Beginner"}}]), - gs:create(menuitem,M,[{label,{text,"Intermediate"}}]), - gs:create(menuitem,M,[{label,{text,"Advanced"}}]), - gs:create(menuitem,M,[{label,{text,"Expert"}}]), - done. - - -setup_board(Shell,X,Y,W,H) -> - F = gs:create(frame, Shell,[{x,X}, {y,Y}, - {width,W}, {height,H},{bg,white}]), - display_board(F). - - -mk_button(Label, Parent, X, Y, W, H) -> - gs:create(button,Parent,[{width,W}, {height, H}, {x,X}, {y,Y}, - {label, {text, Label}}, {bg,white}, - {activefg,white}, {activebg,black}]). - -%% Centers a button around Width -mk_button_c(Label, Parent, Width, Y, W, H) -> - X = trunc((Width-W)/2), - gs:create(button,Parent,[{width,W}, {height, H}, {x,X}, {y,Y}, - {label, {text, Label}}, {bg,white}]). - - -butbit(Button,Col) -> - gs:config(Button,[ - {label,{image,bitmap(Col)}}, - {fg, Col}, - {activefg,Col}, - {label, {image, bitmap(Col)}}]), - Button. - -mk_board_butt(Top,Name,X,Y,Col) -> - B = gs:create(button,list_to_atom(Name), Top, - [{x,X}, {y,Y}, {width,60}, {height,60}, - {padx,5},{pady,5}, - {relief,flat}, - {bg,?BGCOL}, {activebg,?BGCOL}]), - butbit(B,Col), - B. - - - -display_board(Top) -> - Board = board(), - display_board(Top,Board,1). - -display_board(_,_,65) -> true; -display_board(Top,[H|T],Place) -> - [Name,Colour,_] = H, - {X,Y} = xy_position(H), - Button = mk_board_butt(Top,Name,X,Y,Colour), - %%Button = mk_button("",Name,Top,X,Y,60,60), - put(Name,Button), - %%Bitmap = bitmap(Colour), - %%butbit(Button,Bitmap), - %%set_widget(Button,"internalWidth","1"), - %%set_widget(Button,"internalHeight","1"), - %%borderWidth(2,Button), - display_board(Top,T,Place+1). - - diff --git a/lib/gs/contribs/othello/priv/marker.bm b/lib/gs/contribs/othello/priv/marker.bm deleted file mode 100644 index fe7f3df820..0000000000 --- a/lib/gs/contribs/othello/priv/marker.bm +++ /dev/null @@ -1,43 +0,0 @@ -#define marker2_width 60 -#define marker2_height 60 -static unsigned char marker2_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0x0f, 0x00, 0x00, 0x00, - 0x00, 0x00, 0xc0, 0xff, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0xff, - 0xff, 0x03, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, 0xff, 0x0f, 0x00, 0x00, - 0x00, 0x00, 0xff, 0xff, 0xff, 0x1f, 0x00, 0x00, 0x00, 0x80, 0xff, 0xff, - 0xff, 0x3f, 0x00, 0x00, 0x00, 0xe0, 0xff, 0xff, 0xff, 0xff, 0x00, 0x00, - 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, 0x01, 0x00, 0x00, 0xf8, 0xff, 0xff, - 0xff, 0xff, 0x03, 0x00, 0x00, 0xf8, 0xff, 0xff, 0xff, 0xff, 0x03, 0x00, - 0x00, 0xfc, 0xff, 0xff, 0xff, 0xff, 0x07, 0x00, 0x00, 0xfe, 0xff, 0xff, - 0xff, 0xff, 0x0f, 0x00, 0x00, 0xff, 0xff, 0xff, 0xff, 0xff, 0x1f, 0x00, - 0x00, 0xff, 0xff, 0xff, 0xff, 0xff, 0x1f, 0x00, 0x80, 0xff, 0xff, 0xff, - 0xff, 0xff, 0x3f, 0x00, 0x80, 0xff, 0xff, 0xff, 0xff, 0xff, 0x3f, 0x00, - 0x80, 0xff, 0xff, 0xff, 0xff, 0xff, 0x3f, 0x00, 0xc0, 0xff, 0xff, 0xff, - 0xff, 0xff, 0x7f, 0x00, 0xc0, 0xff, 0xff, 0xff, 0xff, 0xff, 0x7f, 0x00, - 0xc0, 0xff, 0xff, 0xff, 0xff, 0xff, 0x7f, 0x00, 0xe0, 0xff, 0xff, 0xff, - 0xff, 0xff, 0xff, 0x00, 0xe0, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x00, - 0xe0, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x00, 0xe0, 0xff, 0xff, 0xff, - 0xff, 0xff, 0xff, 0x00, 0xe0, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x00, - 0xe0, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x00, 0xe0, 0xff, 0xff, 0xff, - 0xff, 0xff, 0xff, 0x00, 0xe0, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x00, - 0xe0, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x00, 0xe0, 0xff, 0xff, 0xff, - 0xff, 0xff, 0xff, 0x00, 0xe0, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x00, - 0xc0, 0xff, 0xff, 0xff, 0xff, 0xff, 0x7e, 0x00, 0xc0, 0xff, 0xff, 0xff, - 0xff, 0xff, 0x7f, 0x00, 0xc0, 0xff, 0xff, 0xff, 0xff, 0x7f, 0x7f, 0x00, - 0x80, 0xff, 0xff, 0xff, 0xff, 0x7f, 0x3f, 0x00, 0x80, 0xff, 0xff, 0xff, - 0xff, 0x3f, 0x3f, 0x00, 0x80, 0xff, 0xff, 0xff, 0xff, 0x1f, 0x3f, 0x00, - 0x00, 0xff, 0xff, 0xff, 0xff, 0x9f, 0x1f, 0x00, 0x00, 0xff, 0xff, 0xff, - 0xff, 0xcf, 0x1f, 0x00, 0x00, 0xfe, 0xff, 0xff, 0xff, 0xc7, 0x0f, 0x00, - 0x00, 0xfc, 0xff, 0xff, 0xff, 0xe7, 0x07, 0x00, 0x00, 0xf8, 0xff, 0xff, - 0x7f, 0xf1, 0x03, 0x00, 0x00, 0xf8, 0xff, 0xff, 0xbf, 0xfc, 0x03, 0x00, - 0x00, 0xf0, 0xff, 0xff, 0x59, 0xff, 0x01, 0x00, 0x00, 0xe0, 0xff, 0xff, - 0xff, 0xff, 0x00, 0x00, 0x00, 0x80, 0xff, 0xff, 0xff, 0x3f, 0x00, 0x00, - 0x00, 0x00, 0xff, 0xff, 0xff, 0x1f, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, - 0xff, 0x0f, 0x00, 0x00, 0x00, 0x00, 0xf8, 0xff, 0xff, 0x03, 0x00, 0x00, - 0x00, 0x00, 0xc0, 0xff, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, - 0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; diff --git a/lib/gs/contribs/othello/priv/square.bm b/lib/gs/contribs/othello/priv/square.bm deleted file mode 100644 index 4e6880b330..0000000000 --- a/lib/gs/contribs/othello/priv/square.bm +++ /dev/null @@ -1,43 +0,0 @@ -#define square_width 60 -#define square_height 60 -static unsigned char square_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; diff --git a/lib/gs/test/Makefile b/lib/gs/test/Makefile index 493770745f..067e1adbb6 100644 --- a/lib/gs/test/Makefile +++ b/lib/gs/test/Makefile @@ -25,7 +25,7 @@ RELSYSDIR = $(RELEASE_PATH)/gs_test # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +ERL_COMPILE_FLAGS += EBIN = . diff --git a/lib/hipe/cerl/cerl_cconv.erl b/lib/hipe/cerl/cerl_cconv.erl index 0fc28be5f3..ac9d01ab0e 100644 --- a/lib/hipe/cerl/cerl_cconv.erl +++ b/lib/hipe/cerl/cerl_cconv.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2015. 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. @@ -710,7 +710,7 @@ ren__new() -> ren__add(Key, Value, Ren) -> dict:store(Key, Value, Ren). -ren__map(Key, Ren) -> +ren__map(Key, Ren) -> case dict:find(Key, Ren) of {ok, Value} -> Value; @@ -722,11 +722,14 @@ ren__map(Key, Ren) -> %% --------------------------------------------------------------------- %% State --record(state, {module :: module(), function :: {atom(), arity()}, - names, refs, defs = []}). +-record(state, {module :: module(), + function :: {atom(), arity()} | 'undefined', + names = sets:new() :: sets:set(), %% XXX: refine + refs = dict:new() :: dict:dict(), %% XXX: refine + defs = []}). s__new(Module) -> - #state{module = Module, names = sets:new(), refs = dict:new()}. + #state{module = Module}. s__add_function_name(Name, S) -> S#state{names = sets:add_element(Name, S#state.names)}. diff --git a/lib/hipe/cerl/cerl_hipeify.erl b/lib/hipe/cerl/cerl_hipeify.erl index 8691e80cac..6611abd204 100644 --- a/lib/hipe/cerl/cerl_hipeify.erl +++ b/lib/hipe/cerl/cerl_hipeify.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2012. All Rights Reserved. +%% Copyright Ericsson AB 2003-2015. 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. @@ -623,12 +623,12 @@ ren__map(Key, Ren) -> %% --------------------------------------------------------------------- %% State -%% pmatch = 'true' | 'false' | 'no_duplicates' | 'duplicate_all' +-type pmatch() :: 'true' | 'false' | 'no_duplicates' | 'duplicate_all'. --record(state, {module::atom(), - function::{atom(), 0..256}, - pmatch=true, - revisit = false}). +-record(state, {module :: module(), + function :: {atom(), arity()} | 'undefined', + pmatch = true :: pmatch(), + revisit = false :: boolean()}). s__new(Module) -> #state{module = Module}. diff --git a/lib/hipe/cerl/cerl_prettypr.erl b/lib/hipe/cerl/cerl_prettypr.erl index 7e8b7f60bd..1a6e6999fe 100644 --- a/lib/hipe/cerl/cerl_prettypr.erl +++ b/lib/hipe/cerl/cerl_prettypr.erl @@ -64,8 +64,8 @@ seq_arg/1, seq_body/1, string_lit/1, try_arg/1, try_body/1, try_vars/1, try_evars/1, try_handler/1, tuple_es/1, type/1, values_es/1, var_name/1, - c_map/1, map_arg/1, map_es/1, is_c_map_empty/1, - c_map_pair/2, map_pair_key/1, map_pair_val/1, map_pair_op/1 + map_arg/1, map_es/1, is_c_map_empty/1, + map_pair_key/1, map_pair_val/1, map_pair_op/1 ]). -define(PAPER, 76). @@ -499,12 +499,8 @@ lay_literal(Node, Ctxt) -> lay_cons(Node, Ctxt); V when is_tuple(V) -> lay_tuple(Node, Ctxt); - M when is_map(M), map_size(M) =:= 0 -> - text("~{}~"); M when is_map(M) -> - lay_map(c_map([c_map_pair(abstract(K),abstract(V)) - || {K,V} <- maps:to_list(M)]), - Ctxt) + lay_map(Node, Ctxt) end. lay_var(Node, Ctxt) -> @@ -627,12 +623,10 @@ lay_map_pair(Node, Ctxt) -> K = map_pair_key(Node), V = map_pair_val(Node), OpTxt = case concrete(map_pair_op(Node)) of - assoc -> "::<"; - exact -> "~<" + assoc -> "=>"; + exact -> ":=" end, - beside(floating(text(OpTxt)), - beside(lay(K,Ctxt),beside(floating(text(",")), beside(lay(V,Ctxt), - floating(text(">")))))). + beside(lay(K,Ctxt),beside(floating(text(OpTxt)),lay(V,Ctxt))). lay_let(Node, Ctxt) -> V = lay_value_list(let_vars(Node), Ctxt), diff --git a/lib/hipe/cerl/cerl_to_icode.erl b/lib/hipe/cerl/cerl_to_icode.erl index 97b95f2e7c..ab131c2d01 100644 --- a/lib/hipe/cerl/cerl_to_icode.erl +++ b/lib/hipe/cerl/cerl_to_icode.erl @@ -794,9 +794,9 @@ bitstr_gen_op([V], #ctxt{fail=FL, class=guard}, SizeInfo, ConstInfo, Type, Flags, Base, Offset) -> SL = new_label(), case SizeInfo of - {all,_NewUnit, NewAlign, S1} -> + {all, NewUnit, NewAlign, S1} -> Type = binary, - Name = {bs_put_binary_all, Flags}, + Name = {bs_put_binary_all, NewUnit, Flags}, Primop = {hipe_bs_primop, Name}, {add_code([icode_guardop([Offset], Primop, [V, Base, Offset], SL, FL), @@ -819,9 +819,9 @@ bitstr_gen_op([V], #ctxt{fail=FL, class=guard}, SizeInfo, ConstInfo, bitstr_gen_op([V], _Ctxt, SizeInfo, ConstInfo, Type, Flags, Base, Offset) -> case SizeInfo of - {all, _NewUnit, NewAlign, S} -> + {all, NewUnit, NewAlign, S} -> Type = binary, - Name = {bs_put_binary_all, Flags}, + Name = {bs_put_binary_all, NewUnit, Flags}, Primop = {hipe_bs_primop, Name}, {add_code([icode_call_primop([Offset], Primop, [V, Base, Offset])], S), diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl index c2fb79c089..7684dc4a81 100644 --- a/lib/hipe/cerl/erl_bif_types.erl +++ b/lib/hipe/cerl/erl_bif_types.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2015. All Rights Reserved. +%% 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. @@ -46,7 +46,6 @@ t_bitstr/0, t_boolean/0, t_byte/0, - t_char/0, t_cons/0, t_cons/2, t_cons_hd/1, @@ -87,7 +86,6 @@ t_is_port/2, t_is_maybe_improper_list/2, t_is_reference/2, - t_is_string/1, t_is_subtype/2, t_is_tuple/2, t_list/0, @@ -139,7 +137,7 @@ type(M, F, A) -> type(M, F, A, Xs) -> type(M, F, A, Xs, 'universe'). --type opaques() :: 'universe' | [erl_types:erl_type()]. +-type opaques() :: erl_types:opaques(). -type arg_types() :: [erl_types:erl_type()]. @@ -552,9 +550,6 @@ type(erlang, bit_size, 1, Xs, Opaques) -> type(erlang, byte_size, 1, Xs, Opaques) -> strict(erlang, byte_size, 1, Xs, fun (_) -> t_non_neg_integer() end, Opaques); -type(erlang, disconnect_node, 1, Xs, Opaques) -> - strict(erlang, disconnect_node, 1, Xs, - fun (_) -> t_sup([t_boolean(), t_atom('ignored')]) end, Opaques); %% Guard bif, needs to be here. %% Also much more expressive than anything you could write in a spec... type(erlang, element, 2, Xs, Opaques) -> @@ -583,16 +578,9 @@ type(erlang, element, 2, Xs, Opaques) -> %% Guard bif, needs to be here. type(erlang, float, 1, Xs, Opaques) -> strict(erlang, float, 1, Xs, fun (_) -> t_float() end, Opaques); -type(erlang, fun_info, 1, Xs, Opaques) -> - strict(erlang, fun_info, 1, Xs, - fun (_) -> t_list(t_tuple([t_atom(), t_any()])) end, Opaques); -type(erlang, get_cookie, 0, _, _Opaques) -> t_atom(); % | t_atom('nocookie') %% Guard bif, needs to be here. type(erlang, hd, 1, Xs, Opaques) -> strict(erlang, hd, 1, Xs, fun ([X]) -> t_cons_hd(X) end, Opaques); -type(erlang, integer_to_list, 2, Xs, Opaques) -> - strict(erlang, integer_to_list, 2, Xs, - fun (_) -> t_string() end, Opaques); type(erlang, info, 1, Xs, _) -> type(erlang, system_info, 1, Xs); % alias %% All type tests are guard BIF's and may be implemented in ways that %% cannot be expressed in a type spec, why they are kept in erl_bif_types. @@ -796,8 +784,6 @@ type(erlang, make_tuple, 3, Xs, Opaques) -> _Other -> t_tuple() end end, Opaques); -type(erlang, memory, 0, _, _Opaques) -> - t_list(t_tuple([t_atom(), t_non_neg_fixnum()])); type(erlang, nif_error, 1, Xs, Opaques) -> %% this BIF and the next one are stubs for NIFs and never return strict(erlang, nif_error, 1, Xs, fun (_) -> t_any() end, Opaques); @@ -813,8 +799,6 @@ type(erlang, round, 1, Xs, Opaques) -> strict(erlang, round, 1, Xs, fun (_) -> t_integer() end, Opaques); %% Guard bif, needs to be here. type(erlang, self, 0, _, _Opaques) -> t_pid(); -type(erlang, set_cookie, 2, Xs, Opaques) -> - strict(erlang, set_cookie, 2, Xs, fun (_) -> t_atom('true') end, Opaques); type(erlang, setelement, 3, Xs, Opaques) -> strict(erlang, setelement, 3, Xs, fun ([X1, X2, X3]) -> @@ -849,19 +833,7 @@ type(erlang, setelement, 3, Xs, Opaques) -> %% Guard bif, needs to be here. type(erlang, size, 1, Xs, Opaques) -> strict(erlang, size, 1, Xs, fun (_) -> t_non_neg_integer() end, Opaques); -type(erlang, spawn, 1, Xs, Opaques) -> - strict(erlang, spawn, 1, Xs, fun (_) -> t_pid() end, Opaques); -type(erlang, spawn, 2, Xs, Opaques) -> - strict(erlang, spawn, 2, Xs, fun (_) -> t_pid() end, Opaques); -type(erlang, spawn, 4, Xs, Opaques) -> - strict(erlang, spawn, 4, Xs, fun (_) -> t_pid() end, Opaques); -type(erlang, spawn_link, 1, Xs, _) -> type(erlang, spawn, 1, Xs); % same -type(erlang, spawn_link, 2, Xs, _) -> type(erlang, spawn, 2, Xs); % same -type(erlang, spawn_link, 4, Xs, _) -> type(erlang, spawn, 4, Xs); % same type(erlang, subtract, 2, Xs, _Opaques) -> type(erlang, '--', 2, Xs); % alias -type(erlang, suspend_process, 1, Xs, Opaques) -> - strict(erlang, suspend_process, 1, Xs, - fun (_) -> t_atom('true') end, Opaques); type(erlang, system_info, 1, Xs, Opaques) -> strict(erlang, system_info, 1, Xs, fun ([Type]) -> @@ -926,8 +898,7 @@ type(erlang, system_info, 1, Xs, Opaques) -> t_list(t_pid()); ['os_type'] -> t_tuple([t_sup([t_atom('unix'), - t_atom('win32'), - t_atom('ose')]), + t_atom('win32')]), t_atom()]); ['os_version'] -> t_sup(t_tuple([t_non_neg_fixnum(), @@ -1015,10 +986,6 @@ type(erlang, tuple_to_list, 1, Xs, Opaques) -> end end end, Opaques); -type(erlang, yield, 0, _, _Opaques) -> t_atom('true'); -%%-- ets ---------------------------------------------------------------------- -type(ets, rename, 2, Xs, Opaques) -> - strict(ets, rename, 2, Xs, fun ([_, Name]) -> Name end, Opaques); %%-- hipe_bifs ---------------------------------------------------------------- type(hipe_bifs, add_ref, 2, Xs, Opaques) -> strict(hipe_bifs, add_ref, 2, Xs, fun (_) -> t_nil() end, Opaques); @@ -1678,25 +1645,6 @@ type(lists, zipwith3, 4, Xs, Opaques) -> fun ([F,_As,_Bs,_Cs]) -> t_sup(t_list(t_fun_range(F, Opaques)), t_nil()) end, Opaques); -%%-- string ------------------------------------------------------------------- -type(string, chars, 2, Xs, Opaques) -> % NOTE: added to avoid loss of info - strict(string, chars, 2, Xs, fun (_) -> t_string() end, Opaques); -type(string, chars, 3, Xs, Opaques) -> % NOTE: added to avoid loss of info - strict(string, chars, 3, Xs, - fun ([Char, N, Tail]) -> - case t_is_nil(Tail) of - true -> - type(string, chars, 2, [Char, N]); - false -> - case t_is_string(Tail) of - true -> - t_string(); - false -> - t_sup(t_sup(t_string(), Tail), t_cons(Char, Tail)) - end - end - end, Opaques); - %%----------------------------------------------------------------------------- type(M, F, A, Xs, _O) when is_atom(M), is_atom(F), is_integer(A), 0 =< A, A =< 255 -> @@ -2200,7 +2148,7 @@ type_ranks(Type, I, Min, Max, [TypeClass|Rest], Opaques) -> type_order() -> [t_number(), t_atom(), t_reference(), t_fun(), t_port(), t_pid(), t_tuple(), - t_list(), t_binary()]. + t_map(), t_list(), t_bitstr()]. key_comparisons_fail(X0, KeyPos, TupleList, Opaques) -> X = case t_is_number(t_inf(X0, t_number(), Opaques), Opaques) of @@ -2300,9 +2248,7 @@ arg_types(erlang, bit_size, 1) -> [t_bitstr()]; %% Guard bif, needs to be here. arg_types(erlang, byte_size, 1) -> - [t_binary()]; -arg_types(erlang, disconnect_node, 1) -> - [t_node()]; + [t_bitstr()]; arg_types(erlang, halt, 0) -> []; arg_types(erlang, halt, 1) -> @@ -2322,17 +2268,11 @@ arg_types(erlang, element, 2) -> %% Guard bif, needs to be here. arg_types(erlang, float, 1) -> [t_number()]; -arg_types(erlang, fun_info, 1) -> - [t_fun()]; -arg_types(erlang, get_cookie, 0) -> - []; %% Guard bif, needs to be here. arg_types(erlang, hd, 1) -> [t_cons()]; arg_types(erlang, info, 1) -> arg_types(erlang, system_info, 1); % alias -arg_types(erlang, integer_to_list, 2) -> - [t_integer(), t_from_range(2, 36)]; arg_types(erlang, is_atom, 1) -> [t_any()]; arg_types(erlang, is_binary, 1) -> @@ -2379,8 +2319,6 @@ arg_types(erlang, make_tuple, 2) -> [t_non_neg_fixnum(), t_any()]; % the value 0 is OK as first argument arg_types(erlang, make_tuple, 3) -> [t_non_neg_fixnum(), t_any(), t_list(t_tuple([t_pos_integer(), t_any()]))]; -arg_types(erlang, memory, 0) -> - []; arg_types(erlang, nif_error, 1) -> [t_any()]; arg_types(erlang, nif_error, 2) -> @@ -2397,29 +2335,13 @@ arg_types(erlang, round, 1) -> %% Guard bif, needs to be here. arg_types(erlang, self, 0) -> []; -arg_types(erlang, set_cookie, 2) -> - [t_node(), t_atom()]; arg_types(erlang, setelement, 3) -> [t_pos_integer(), t_tuple(), t_any()]; %% Guard bif, needs to be here. arg_types(erlang, size, 1) -> [t_sup(t_tuple(), t_binary())]; -arg_types(erlang, spawn, 1) -> %% TODO: Tuple? - [t_fun()]; -arg_types(erlang, spawn, 2) -> %% TODO: Tuple? - [t_node(), t_fun()]; -arg_types(erlang, spawn, 4) -> %% TODO: Tuple? - [t_node(), t_atom(), t_atom(), t_list()]; -arg_types(erlang, spawn_link, 1) -> - arg_types(erlang, spawn, 1); % same -arg_types(erlang, spawn_link, 2) -> - arg_types(erlang, spawn, 2); % same -arg_types(erlang, spawn_link, 4) -> - arg_types(erlang, spawn, 4); % same arg_types(erlang, subtract, 2) -> arg_types(erlang, '--', 2); -arg_types(erlang, suspend_process, 1) -> - [t_pid()]; arg_types(erlang, system_info, 1) -> [t_sup([t_atom(), % documented t_tuple([t_atom(), t_any()]), % documented @@ -2438,11 +2360,6 @@ arg_types(erlang, tuple_size, 1) -> [t_tuple()]; arg_types(erlang, tuple_to_list, 1) -> [t_tuple()]; -arg_types(erlang, yield, 0) -> - []; -%%------- ets ----------------------------------------------------------------- -arg_types(ets, rename, 2) -> - [t_atom(), t_atom()]; %%------- hipe_bifs ----------------------------------------------------------- arg_types(hipe_bifs, add_ref, 2) -> [t_mfa(), t_tuple([t_mfa(), @@ -2639,13 +2556,6 @@ arg_types(lists, zipwith, 3) -> [t_fun([t_any(), t_any()], t_any()), t_list(), t_list()]; arg_types(lists, zipwith3, 4) -> [t_fun([t_any(), t_any(), t_any()], t_any()), t_list(), t_list(), t_list()]; - -%%------- string -------------------------------------------------------------- -arg_types(string, chars, 2) -> - [t_char(), t_non_neg_integer()]; -arg_types(string, chars, 3) -> - [t_char(), t_non_neg_integer(), t_any()]; -%%----------------------------------------------------------------------------- arg_types(M, F, A) when is_atom(M), is_atom(F), is_integer(A), 0 =< A, A =< 255 -> unknown. % safe approximation for all functions. diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index cd2d2fe207..fae12d7421 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -140,7 +140,6 @@ t_is_port/1, t_is_port/2, t_is_maybe_improper_list/1, t_is_maybe_improper_list/2, t_is_reference/1, t_is_reference/2, - t_is_remote/1, t_is_string/1, t_is_subtype/2, t_is_tuple/1, t_is_tuple/2, @@ -173,14 +172,12 @@ t_number_vals/1, t_number_vals/2, t_opaque_from_records/1, t_opaque_structure/1, - %% t_parameterized_module/0, t_pid/0, t_port/0, t_maybe_improper_list/0, %% t_maybe_improper_list/2, t_product/1, t_reference/0, - t_remote/3, t_string/0, t_struct_from_opaque/2, t_subst/2, @@ -208,7 +205,6 @@ type_is_defined/4, record_field_diffs_to_string/2, subst_all_vars_to_any/1, - subst_all_remote/2, lift_list_to_pos_empty/1, lift_list_to_pos_empty/2, is_opaque_type/2, is_erl_type/1, @@ -228,7 +224,7 @@ -export([t_is_identifier/1]). -endif. --export_type([erl_type/0, type_table/0, var_table/0]). +-export_type([erl_type/0, opaques/0, type_table/0, var_table/0]). %%-define(DEBUG, true). @@ -280,7 +276,6 @@ -define(number_tag, number). -define(opaque_tag, opaque). -define(product_tag, product). --define(remote_tag, remote). -define(tuple_set_tag, tuple_set). -define(tuple_tag, tuple). -define(union_tag, union). @@ -288,7 +283,7 @@ -type tag() :: ?atom_tag | ?binary_tag | ?function_tag | ?identifier_tag | ?list_tag | ?map_tag | ?matchstate_tag | ?nil_tag | ?number_tag - | ?opaque_tag | ?product_tag | ?remote_tag + | ?opaque_tag | ?product_tag | ?tuple_tag | ?tuple_set_tag | ?union_tag | ?var_tag. -define(float_qual, float). @@ -320,7 +315,7 @@ %% Auxiliary types and convenient macros %% --type parse_form() :: {atom(), _, _} | {atom(), _, _, _} | {'op', _, _, _, _}. %% XXX: Temporarily +-type parse_form() :: erl_parse:abstract_expr(). -type rng_elem() :: 'pos_inf' | 'neg_inf' | integer(). -record(int_set, {set :: [integer()]}). @@ -330,7 +325,6 @@ %% was updated to 2.7 due to this change. -record(opaque, {mod :: module(), name :: atom(), args = [] :: [erl_type()], struct :: erl_type()}). --record(remote, {mod:: module(), name :: atom(), args = [] :: [erl_type()]}). -define(atom(Set), #c{tag=?atom_tag, elements=Set}). -define(bitstr(Unit, Base), #c{tag=?binary_tag, elements=[Unit,Base]}). @@ -350,7 +344,6 @@ -define(map(Pairs), #c{tag=?map_tag, elements=Pairs}). -define(opaque(Optypes), #c{tag=?opaque_tag, elements=Optypes}). -define(product(Types), #c{tag=?product_tag, elements=Types}). --define(remote(RemTypes), #c{tag=?remote_tag, elements=RemTypes}). -define(tuple(Types, Arity, Qual), #c{tag=?tuple_tag, elements=Types, qualifier={Arity, Qual}}). -define(tuple_set(Tuples), #c{tag=?tuple_set_tag, elements=Tuples}). @@ -371,8 +364,8 @@ -type type_key() :: {'type' | 'opaque', atom(), arity()}. -type record_value() :: [{atom(), erl_parse:abstract_expr(), erl_type()}]. -type type_value() :: {module(), erl_type(), atom()}. --type type_table() :: dict:dict(record_key(), record_value()) - | dict:dict(type_key(), type_value()). +-type type_table() :: dict:dict(record_key() | type_key(), + record_value() | type_value()). -type var_table() :: dict:dict(atom(), erl_type()). @@ -380,19 +373,18 @@ %% Unions %% --define(union(List), #c{tag=?union_tag, elements=[_,_,_,_,_,_,_,_,_,_,_]=List}). - --define(atom_union(T), ?union([T,?none,?none,?none,?none,?none,?none,?none,?none,?none,?none])). --define(bitstr_union(T), ?union([?none,T,?none,?none,?none,?none,?none,?none,?none,?none,?none])). --define(function_union(T), ?union([?none,?none,T,?none,?none,?none,?none,?none,?none,?none,?none])). --define(identifier_union(T), ?union([?none,?none,?none,T,?none,?none,?none,?none,?none,?none,?none])). --define(list_union(T), ?union([?none,?none,?none,?none,T,?none,?none,?none,?none,?none,?none])). --define(number_union(T), ?union([?none,?none,?none,?none,?none,T,?none,?none,?none,?none,?none])). --define(tuple_union(T), ?union([?none,?none,?none,?none,?none,?none,T,?none,?none,?none,?none])). --define(matchstate_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,T,?none,?none,?none])). --define(opaque_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,?none,T,?none,?none])). --define(remote_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,?none,?none,T,?none])). --define(map_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,?none,?none,?none,T])). +-define(union(List), #c{tag=?union_tag, elements=[_,_,_,_,_,_,_,_,_,_]=List}). + +-define(atom_union(T), ?union([T,?none,?none,?none,?none,?none,?none,?none,?none,?none])). +-define(bitstr_union(T), ?union([?none,T,?none,?none,?none,?none,?none,?none,?none,?none])). +-define(function_union(T), ?union([?none,?none,T,?none,?none,?none,?none,?none,?none,?none])). +-define(identifier_union(T), ?union([?none,?none,?none,T,?none,?none,?none,?none,?none,?none])). +-define(list_union(T), ?union([?none,?none,?none,?none,T,?none,?none,?none,?none,?none])). +-define(number_union(T), ?union([?none,?none,?none,?none,?none,T,?none,?none,?none,?none])). +-define(tuple_union(T), ?union([?none,?none,?none,?none,?none,?none,T,?none,?none,?none])). +-define(matchstate_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,T,?none,?none])). +-define(opaque_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,?none,T,?none])). +-define(map_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,?none,?none,T])). -define(integer_union(T), ?number_union(T)). -define(float_union(T), ?number_union(T)). -define(nil_union(T), ?list_union(T)). @@ -679,8 +671,8 @@ list_decorate(List, L, Opaques) -> union_decorate(U1, U2, Opaques) -> Union = union_decorate(U1, U2, Opaques, 0, []), - [A,B,F,I,L,N,T,M,_,_R,Map] = U1, - [_,_,_,_,_,_,_,_,Opaque,_,_] = U2, + [A,B,F,I,L,N,T,M,_,Map] = U1, + [_,_,_,_,_,_,_,_,Opaque,_] = U2, List = [A,B,F,I,L,N,T,M,Map], DecList = [Dec || E <- List, @@ -792,21 +784,6 @@ list_struct_from_opaque(Types, Opaques) -> [t_struct_from_opaque(Type, Opaques) || Type <- Types]. %%----------------------------------------------------------------------------- -%% Remote types: these types are used for preprocessing; -%% they should never reach the analysis stage. - --spec t_remote(atom(), atom(), [erl_type()]) -> erl_type(). - -t_remote(Mod, Name, Args) -> - ?remote(set_singleton(#remote{mod = Mod, name = Name, args = Args})). - --spec t_is_remote(erl_type()) -> boolean(). - -t_is_remote(Type) -> - do_opaque(Type, 'universe', fun is_remote/1). - -is_remote(?remote(_)) -> true; -is_remote(_) -> false. -type mod_records() :: dict:dict(module(), type_table()). @@ -1807,7 +1784,7 @@ t_mfa() -> -spec t_module() -> erl_type(). t_module() -> - t_sup(t_atom(), t_parameterized_module()). + t_atom(). -spec t_node() -> erl_type(). @@ -1833,11 +1810,6 @@ t_iolist(N, T) when N > 0 -> t_iolist(0, T) -> t_maybe_improper_list(t_any(), t_sup(T, t_nil())). --spec t_parameterized_module() -> erl_type(). - -t_parameterized_module() -> - t_tuple(). - -spec t_timeout() -> erl_type(). t_timeout() -> @@ -2178,8 +2150,6 @@ t_sup(?opaque(Set1), ?opaque(Set2)) -> %% io:format("Debug: t_sup executed with args ~w and ~w~n",[T1, T2]), ?none; %%t_sup(T1, T2=?opaque(_,_,_)) -> %% io:format("Debug: t_sup executed with args ~w and ~w~n",[T1, T2]), ?none; -t_sup(?remote(Set1), ?remote(Set2)) -> - ?remote(set_union_no_limit(Set1, Set2)); t_sup(?matchstate(Pres1, Slots1), ?matchstate(Pres2, Slots2)) -> ?matchstate(t_sup(Pres1, Pres2), t_sup(Slots1, Slots2)); t_sup(?nil, ?nil) -> ?nil; @@ -2373,7 +2343,6 @@ force_union(T = ?list(_, _, _)) -> ?list_union(T); force_union(T = ?nil) -> ?list_union(T); force_union(T = ?number(_, _)) -> ?number_union(T); force_union(T = ?opaque(_)) -> ?opaque_union(T); -force_union(T = ?remote(_)) -> ?remote_union(T); force_union(T = ?map(_)) -> ?map_union(T); force_union(T = ?tuple(_, _, _)) -> ?tuple_union(T); force_union(T = ?tuple_set(_)) -> ?tuple_union(T); @@ -2450,8 +2419,7 @@ t_inf(T1, T2) -> t_inf(T1, T2, 'universe'). %% 'match' should be used from t_find_unknown_opaque() only --type t_inf_opaques() :: 'universe' - | [erl_type()] | {'match', [erl_type() | 'universe']}. +-type t_inf_opaques() :: opaques() | {'match', [erl_type() | 'universe']}. -spec t_inf(erl_type(), erl_type(), t_inf_opaques()) -> erl_type(). @@ -2711,7 +2679,6 @@ is_compat_args([A1|Args1], [A2|Args2]) -> is_compat_args([], []) -> true; is_compat_args(_, _) -> false. -is_compat_arg(A, A) -> true; is_compat_arg(A1, A2) -> is_specialization(A1, A2) orelse is_specialization(A2, A1). @@ -2722,6 +2689,7 @@ is_compat_arg(A1, A2) -> %% any(). For example, {_,_} is a specialization of any(), but not of %% tuple(). Does not handle variables, but any() and unions (sort of). +is_specialization(T, T) -> true; is_specialization(_, ?any) -> true; is_specialization(?any, _) -> false; is_specialization(?function(Domain1, Range1), ?function(Domain2, Range2)) -> @@ -2747,8 +2715,8 @@ is_specialization(?tuple(Elements1, Arity, _), specialization_list(Elements1, sup_tuple_elements(List)); is_specialization(?tuple_set(List1), ?tuple_set(List2)) -> try - specialization_list(lists:append([T || {_Arity, T} <- List1]), - lists:append([T || {_Arity, T} <- List2])) + specialization_list_list([sup_tuple_elements(T) || {_Arity, T} <- List1], + [sup_tuple_elements(T) || {_Arity, T} <- List2]) catch _:_ -> false end; is_specialization(?union(List1)=T1, ?union(List2)=T2) -> @@ -2772,13 +2740,19 @@ is_specialization(T1, ?opaque(_) = T2) -> is_specialization(T1, t_opaque_structure(T2)); is_specialization(?var(_), _) -> exit(error); is_specialization(_, ?var(_)) -> exit(error); -is_specialization(T, T) -> true; is_specialization(?none, _) -> false; is_specialization(_, ?none) -> false; is_specialization(?unit, _) -> false; is_specialization(_, ?unit) -> false; is_specialization(#c{}, #c{}) -> false. +specialization_list_list(LL1, LL2) -> + length(LL1) =:= length(LL2) andalso specialization_list_list1(LL1, LL2). + +specialization_list_list1([], []) -> true; +specialization_list_list1([L1|LL1], [L2|LL2]) -> + specialization_list(L1, L2) andalso specialization_list_list1(LL1, LL2). + specialization_list(L1, L2) -> length(L1) =:= length(L2) andalso specialization_list1(L1, L2). @@ -2880,8 +2854,8 @@ inf_tuples_in_sets2(_, [], Acc, _Opaques) -> lists:reverse(Acc). inf_union(U1, U2, Opaques) -> OpaqueFun = fun(Union1, Union2, InfFun) -> - [_,_,_,_,_,_,_,_,Opaque,_,_] = Union1, - [A,B,F,I,L,N,T,M,_,_R,Map] = Union2, + [_,_,_,_,_,_,_,_,Opaque,_] = Union1, + [A,B,F,I,L,N,T,M,_,Map] = Union2, List = [A,B,F,I,L,N,T,M,Map], inf_union_collect(List, Opaque, InfFun, [], []) end, @@ -3060,18 +3034,6 @@ t_subst_aux(?union(List), VarMap) -> ?union([t_subst_aux(E, VarMap) || E <- List]); t_subst_aux(T, _VarMap) -> T. - --spec subst_all_remote(erl_type(), erl_type()) -> erl_type(). - -subst_all_remote(Type0, Substitute) -> - Map = - fun(Type) -> - case t_is_remote(Type) of - true -> Substitute; - false -> Type - end - end, - t_map(Map, Type0). %%----------------------------------------------------------------------------- %% Unification @@ -3175,11 +3137,11 @@ unify_union1(?union(List), T1, T2) -> end. unify_union(List) -> - [A,B,F,I,L,N,T,M,O,R,Map] = List, + [A,B,F,I,L,N,T,M,O,Map] = List, if O =:= ?none -> no; true -> S = t_opaque_structure(O), - {yes, t_sup([A,B,F,I,L,N,T,M,S,R,Map])} + {yes, t_sup([A,B,F,I,L,N,T,M,S,Map])} end. -spec is_opaque_type(erl_type(), [erl_type()]) -> boolean(). @@ -3537,10 +3499,10 @@ t_subtract_lists([], [], Acc) -> -spec subtract_union([erl_type(),...], [erl_type(),...]) -> erl_type(). subtract_union(U1, U2) -> - [A1,B1,F1,I1,L1,N1,T1,M1,O1,R1,Map1] = U1, - [A2,B2,F2,I2,L2,N2,T2,M2,O2,R2,Map2] = U2, - List1 = [A1,B1,F1,I1,L1,N1,T1,M1,?none,R1,Map1], - List2 = [A2,B2,F2,I2,L2,N2,T2,M2,?none,R2,Map2], + [A1,B1,F1,I1,L1,N1,T1,M1,O1,Map1] = U1, + [A2,B2,F2,I2,L2,N2,T2,M2,O2,Map2] = U2, + List1 = [A1,B1,F1,I1,L1,N1,T1,M1,?none,Map1], + List2 = [A2,B2,F2,I2,L2,N2,T2,M2,?none,Map2], Sub1 = subtract_union(List1, List2, 0, []), O = if O1 =:= ?none -> O1; true -> t_subtract(O1, ?union(U2)) @@ -3635,7 +3597,7 @@ t_is_instance(ConcreteType, Type) -> t_unopaque(T) -> t_unopaque(T, 'universe'). --spec t_unopaque(erl_type(), 'universe' | [erl_type()]) -> erl_type(). +-spec t_unopaque(erl_type(), opaques()) -> erl_type(). t_unopaque(?opaque(_) = T, Opaques) -> case Opaques =:= 'universe' orelse is_opaque_type(T, Opaques) of @@ -3656,7 +3618,7 @@ t_unopaque(?product(Types), Opaques) -> ?product([t_unopaque(T, Opaques) || T <- Types]); t_unopaque(?function(Domain, Range), Opaques) -> ?function(t_unopaque(Domain, Opaques), t_unopaque(Range, Opaques)); -t_unopaque(?union([A,B,F,I,L,N,T,M,O,R,Map]), Opaques) -> +t_unopaque(?union([A,B,F,I,L,N,T,M,O,Map]), Opaques) -> UL = t_unopaque(L, Opaques), UT = t_unopaque(T, Opaques), UF = t_unopaque(F, Opaques), @@ -3665,7 +3627,7 @@ t_unopaque(?union([A,B,F,I,L,N,T,M,O,R,Map]), Opaques) -> ?opaque(_) = O1 -> {O1, []}; Type -> {?none, [Type]} end, - t_sup([?union([A,B,UF,I,UL,N,UT,M,OF,R,UMap])|UO]); + t_sup([?union([A,B,UF,I,UL,N,UT,M,OF,UMap])|UO]); t_unopaque(T, _) -> T. @@ -3932,16 +3894,6 @@ t_to_string(?float, _RecDict) -> "float()"; t_to_string(?number(?any, ?unknown_qual), _RecDict) -> "number()"; t_to_string(?product(List), RecDict) -> "<" ++ comma_sequence(List, RecDict) ++ ">"; -t_to_string(?remote(Set), RecDict) -> - string:join([case Args =:= [] of - true -> flat_format("~w:~w()", [Mod, Name]); - false -> - ArgString = comma_sequence(Args, RecDict), - flat_format("~w:~w(~s)", [Mod, Name, ArgString]) - end - || #remote{mod = Mod, name = Name, args = Args} <- - set_to_list(Set)], - " | "); t_to_string(?map(Pairs), RecDict) -> "#{" ++ map_pairs_to_string(Pairs,RecDict) ++ "}"; t_to_string(?tuple(?any, ?any, ?any), _RecDict) -> "tuple()"; @@ -3974,18 +3926,17 @@ record_to_string(Tag, [_|Fields], FieldNames, RecDict) -> FieldStrings = record_fields_to_string(Fields, FieldNames, RecDict, []), "#" ++ atom_to_string(Tag) ++ "{" ++ string:join(FieldStrings, ",") ++ "}". -record_fields_to_string([F|Fs], [{FName, _Abstr, _DefType}|FDefs], +record_fields_to_string([F|Fs], [{FName, _Abstr, DefType}|FDefs], RecDict, Acc) -> NewAcc = - case t_is_equal(F, t_any()) orelse t_is_any_atom('undefined', F) of + case + t_is_equal(F, t_any()) orelse + (t_is_any_atom('undefined', F) andalso + not t_is_none(t_inf(F, DefType))) + of true -> Acc; false -> StrFV = atom_to_string(FName) ++ "::" ++ t_to_string(F, RecDict), - %% ActualDefType = t_subtract(DefType, t_atom('undefined')), - %% Str = case t_is_any(ActualDefType) of - %% true -> StrFV; - %% false -> StrFV ++ "::" ++ t_to_string(ActualDefType, RecDict) - %% end, [StrFV|Acc] end, record_fields_to_string(Fs, FDefs, RecDict, NewAcc); @@ -4825,13 +4776,13 @@ do_opaque(?opaque(_) = Type, Opaques, Pred) -> false -> Pred(Type) end; do_opaque(?union(List) = Type, Opaques, Pred) -> - [A,B,F,I,L,N,T,M,O,R,Map] = List, + [A,B,F,I,L,N,T,M,O,Map] = List, if O =:= ?none -> Pred(Type); true -> case Opaques =:= 'universe' orelse is_opaque_type(O, Opaques) of true -> S = t_opaque_structure(O), - do_opaque(t_sup([A,B,F,I,L,N,T,M,S,R,Map]), Opaques, Pred); + do_opaque(t_sup([A,B,F,I,L,N,T,M,S,Map]), Opaques, Pred); false -> Pred(Type) end end; @@ -4865,10 +4816,6 @@ set_union(S1, S2) -> _ -> ?any end. -set_union_no_limit(?any, _) -> ?any; -set_union_no_limit(_, ?any) -> ?any; -set_union_no_limit(S1, S2) -> ordsets:union(S1, S2). - %% The intersection and subtraction can return ?none. %% This should always be handled right away since ?none is not a valid set. %% However, ?any is considered a valid set. diff --git a/lib/hipe/flow/cfg.hrl b/lib/hipe/flow/cfg.hrl index f79fff4efe..641ec102db 100644 --- a/lib/hipe/flow/cfg.hrl +++ b/lib/hipe/flow/cfg.hrl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2014. All Rights Reserved. +%% Copyright Ericsson AB 2007-2015. 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. @@ -34,11 +34,13 @@ %% -record(cfg_info, {'fun' :: mfa(), start_label :: cfg_lbl(), + %% TODO: merge is_closure and closure_arity into one field is_closure :: boolean(), - closure_arity :: arity(), + closure_arity = none :: 'none' | arity(), is_leaf :: boolean(), params, % :: list() info = []}). %% this field seems not needed; take out?? +-type cfg_info() :: #cfg_info{}. %% %% Data is a triple with a dict of constants, a list of labels and an integer @@ -49,6 +51,6 @@ %% The following is to be used by other modules %% -record(cfg, {table = gb_trees:empty() :: gb_trees:tree(), - info :: #cfg_info{}, + info :: cfg_info(), data :: cfg_data()}). -type cfg() :: #cfg{}. diff --git a/lib/hipe/icode/hipe_beam_to_icode.erl b/lib/hipe/icode/hipe_beam_to_icode.erl index 0c7bdb788a..37c6ba9c60 100644 --- a/lib/hipe/icode/hipe_beam_to_icode.erl +++ b/lib/hipe/icode/hipe_beam_to_icode.erl @@ -881,6 +881,15 @@ trans_fun([{bs_init_bits,{f,Lbl},Size,_Words,_LiveRegs,{field_flags,Flags0},X}| trans_fun([{bs_add, {f,Lbl}, [Old,New,Unit], Res}|Instructions], Env) -> Dst = mk_var(Res), Temp = mk_var(new), + {FailLblName, FailCode} = + if Lbl =:= 0 -> + FailLbl = mk_label(new), + {hipe_icode:label_name(FailLbl), + [FailLbl, + hipe_icode:mk_fail([hipe_icode:mk_const(badarg)], error)]}; + true -> + {map_label(Lbl), []} + end, MultIs = case {New,Unit} of {{integer, NewInt}, _} -> @@ -890,40 +899,26 @@ trans_fun([{bs_add, {f,Lbl}, [Old,New,Unit], Res}|Instructions], Env) -> [hipe_icode:mk_move(Temp, NewVar)]; _ -> NewVar = mk_var(New), - if Lbl =:= 0 -> - [hipe_icode:mk_primop([Temp], '*', - [NewVar, hipe_icode:mk_const(Unit)])]; - true -> - Succ = mk_label(new), - [hipe_icode:mk_primop([Temp], '*', - [NewVar, hipe_icode:mk_const(Unit)], - hipe_icode:label_name(Succ), map_label(Lbl)), - Succ] - end + Succ = mk_label(new), + [hipe_icode:mk_primop([Temp], '*', + [NewVar, hipe_icode:mk_const(Unit)], + hipe_icode:label_name(Succ), FailLblName), + Succ] end, Succ2 = mk_label(new), - {FailLblName, FailCode} = - if Lbl =:= 0 -> - FailLbl = mk_label(new), - {hipe_icode:label_name(FailLbl), - [FailLbl, - hipe_icode:mk_fail([hipe_icode:mk_const(badarg)], error)]}; - true -> - {map_label(Lbl), []} - end, IsPos = [hipe_icode:mk_if('>=', [Temp, hipe_icode:mk_const(0)], hipe_icode:label_name(Succ2), FailLblName)] ++ - FailCode ++ [Succ2], - AddI = + FailCode ++ [Succ2], + AddRhs = case Old of - {integer,OldInt} -> - hipe_icode:mk_primop([Dst], '+', [Temp, hipe_icode:mk_const(OldInt)]); - _ -> - OldVar = mk_var(Old), - hipe_icode:mk_primop([Dst], '+', [Temp, OldVar]) + {integer,OldInt} -> hipe_icode:mk_const(OldInt); + _ -> mk_var(Old) end, - MultIs ++ IsPos ++ [AddI|trans_fun(Instructions, Env)]; + Succ3 = mk_label(new), + AddI = hipe_icode:mk_primop([Dst], '+', [Temp, AddRhs], + hipe_icode:label_name(Succ3), FailLblName), + MultIs ++ IsPos ++ [AddI,Succ3|trans_fun(Instructions, Env)]; %%-------------------------------------------------------------------- %% Bit syntax instructions added in R12B-5 (Fall 2008) %%-------------------------------------------------------------------- @@ -1306,7 +1301,7 @@ trans_bin([{bs_put_binary,{f,Lbl},Size,Unit,{field_flags,Flags},Source}| {Name, Args, Env2} = case Size of {atom,all} -> %% put all bits - {{bs_put_binary_all, Flags}, [Src,Base,Offset], Env}; + {{bs_put_binary_all, Unit, Flags}, [Src,Base,Offset], Env}; {integer,NoBits} when is_integer(NoBits), NoBits >= 0 -> %% Create a N*Unit bits subbinary {{bs_put_binary, NoBits*Unit, Flags}, [Src,Base,Offset], Env}; diff --git a/lib/hipe/icode/hipe_icode.erl b/lib/hipe/icode/hipe_icode.erl index 5c7003b0ed..07d230491d 100644 --- a/lib/hipe/icode/hipe_icode.erl +++ b/lib/hipe/icode/hipe_icode.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2013. All Rights Reserved. +%% Copyright Ericsson AB 2001-2015. 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. @@ -631,59 +631,59 @@ mk_icode(Fun, Params, IsClosure, IsLeaf, Code, VarRange, LabelRange) -> -spec mk_icode(mfa(), [icode_var()], boolean(), boolean(), [icode_instr()], hipe_consttab(), {non_neg_integer(),non_neg_integer()}, - {icode_lbl(),icode_lbl()}) -> #icode{}. + {icode_lbl(),icode_lbl()}) -> icode(). mk_icode(Fun, Params, IsClosure, IsLeaf, Code, Data, VarRange, LabelRange) -> #icode{'fun'=Fun, params=Params, code=Code, data=Data, is_closure=IsClosure, is_leaf=IsLeaf, var_range=VarRange, label_range=LabelRange}. --spec icode_fun(#icode{}) -> mfa(). +-spec icode_fun(icode()) -> mfa(). icode_fun(#icode{'fun' = MFA}) -> MFA. --spec icode_params(#icode{}) -> [icode_var()]. +-spec icode_params(icode()) -> [icode_var()]. icode_params(#icode{params = Params}) -> Params. --spec icode_params_update(#icode{}, [icode_var()]) -> #icode{}. +-spec icode_params_update(icode(), [icode_var()]) -> icode(). icode_params_update(Icode, Params) -> Icode#icode{params = Params}. --spec icode_is_closure(#icode{}) -> boolean(). +-spec icode_is_closure(icode()) -> boolean(). icode_is_closure(#icode{is_closure = Closure}) -> Closure. --spec icode_is_leaf(#icode{}) -> boolean(). +-spec icode_is_leaf(icode()) -> boolean(). icode_is_leaf(#icode{is_leaf = Leaf}) -> Leaf. --spec icode_code(#icode{}) -> icode_instrs(). +-spec icode_code(icode()) -> icode_instrs(). icode_code(#icode{code = Code}) -> Code. --spec icode_code_update(#icode{}, icode_instrs()) -> #icode{}. +-spec icode_code_update(icode(), icode_instrs()) -> icode(). icode_code_update(Icode, NewCode) -> Vmax = highest_var(NewCode), Lmax = highest_label(NewCode), Icode#icode{code = NewCode, var_range = {0,Vmax}, label_range = {0,Lmax}}. --spec icode_data(#icode{}) -> hipe_consttab(). +-spec icode_data(icode()) -> hipe_consttab(). icode_data(#icode{data=Data}) -> Data. -%% %% -spec icode_data_update(#icode{}, hipe_consttab()) -> #icode{}. +%% %% -spec icode_data_update(icode(), hipe_consttab()) -> icode(). %% icode_data_update(Icode, NewData) -> Icode#icode{data=NewData}. --spec icode_var_range(#icode{}) -> {non_neg_integer(), non_neg_integer()}. +-spec icode_var_range(icode()) -> {non_neg_integer(), non_neg_integer()}. icode_var_range(#icode{var_range = VarRange}) -> VarRange. --spec icode_label_range(#icode{}) -> {non_neg_integer(), non_neg_integer()}. +-spec icode_label_range(icode()) -> {non_neg_integer(), non_neg_integer()}. icode_label_range(#icode{label_range = LabelRange}) -> LabelRange. --spec icode_info(#icode{}) -> icode_info(). +-spec icode_info(icode()) -> icode_info(). icode_info(#icode{info = Info}) -> Info. --spec icode_info_update(#icode{}, icode_info()) -> #icode{}. +-spec icode_info_update(icode(), icode_info()) -> icode(). icode_info_update(Icode, Info) -> Icode#icode{info = Info}. --spec icode_closure_arity(#icode{}) -> arity(). +-spec icode_closure_arity(icode()) -> arity(). icode_closure_arity(#icode{closure_arity = Arity}) -> Arity. --spec icode_closure_arity_update(#icode{}, arity()) -> #icode{}. +-spec icode_closure_arity_update(icode(), arity()) -> icode(). icode_closure_arity_update(Icode, Arity) -> Icode#icode{closure_arity = Arity}. @@ -1376,12 +1376,12 @@ remove_constants(L) -> %% Substitution: replace occurrences of X by Y if {X,Y} is in the %% Subst_list. --spec subst([{_,_}], I) -> I when is_subtype(I, icode_instr()). +-spec subst([{_,_}], I) -> I when I :: icode_instr(). subst(Subst, I) -> subst_defines(Subst, subst_uses(Subst, I)). --spec subst_uses([{_,_}], I) -> I when is_subtype(I, icode_instr()). +-spec subst_uses([{_,_}], I) -> I when I :: icode_instr(). subst_uses(Subst, I) -> case I of @@ -1405,7 +1405,7 @@ subst_uses(Subst, I) -> #icode_label{} -> I end. --spec subst_defines([{_,_}], I) -> I when is_subtype(I, icode_instr()). +-spec subst_defines([{_,_}], I) -> I when I :: icode_instr(). subst_defines(Subst, I) -> case I of @@ -1709,7 +1709,7 @@ mk_new_label() -> %% @doc Removes comments from Icode. %% --spec strip_comments(#icode{}) -> #icode{}. +-spec strip_comments(icode()) -> icode(). strip_comments(ICode) -> icode_code_update(ICode, no_comments(icode_code(ICode))). diff --git a/lib/hipe/icode/hipe_icode.hrl b/lib/hipe/icode/hipe_icode.hrl index 9b24c4914e..3bb7bae019 100644 --- a/lib/hipe/icode/hipe_icode.hrl +++ b/lib/hipe/icode/hipe_icode.hrl @@ -170,8 +170,9 @@ -record(icode, {'fun' :: mfa(), params :: [icode_var()], + %% TODO: merge is_closure and closure_arity into one field is_closure :: boolean(), - closure_arity :: arity(), + closure_arity = none :: 'none' | arity(), is_leaf :: boolean(), code = [] :: icode_instrs(), data :: hipe_consttab(), diff --git a/lib/hipe/icode/hipe_icode_exceptions.erl b/lib/hipe/icode/hipe_icode_exceptions.erl index 41556ab80f..f03ce2faaa 100644 --- a/lib/hipe/icode/hipe_icode_exceptions.erl +++ b/lib/hipe/icode/hipe_icode_exceptions.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2014. All Rights Reserved. +%% Copyright Ericsson AB 2004-2015. 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. @@ -85,7 +85,7 @@ %%---------------------------------------------------------------------------- --spec fix_catches(#cfg{}) -> #cfg{}. +-spec fix_catches(cfg()) -> cfg(). fix_catches(CFG) -> {Map, State} = build_mapping(find_catches(init_state(CFG))), @@ -393,10 +393,10 @@ get_renaming(C, Map) -> %%--------------------------------------------------------------------- %% State abstraction --record(state, {cfg :: #cfg{}, +-record(state, {cfg :: cfg(), changed = false :: boolean(), - succ :: #cfg{}, - pred :: #cfg{}, + succ :: cfg(), + pred :: cfg(), start_labels :: [icode_lbl(),...], visited = hipe_icode_cfg:none_visited() :: gb_sets:set(), out = gb_trees:empty() :: gb_trees:tree(), @@ -404,13 +404,8 @@ get_renaming(C, Map) -> }). init_state(CFG) -> - State = #state{cfg = CFG}, - refresh_state_cache(State). - -refresh_state_cache(State) -> - CFG = State#state.cfg, SLs = [hipe_icode_cfg:start_label(CFG)], - State#state{succ = CFG, pred = CFG, start_labels = SLs}. + #state{cfg = CFG, succ = CFG, pred = CFG, start_labels = SLs}. get_cfg(State) -> State#state.cfg. @@ -466,7 +461,8 @@ get_bb_code(L, State) -> set_bb_code(L, Code, State) -> CFG = State#state.cfg, CFG1 = hipe_icode_cfg:bb_add(CFG, L, hipe_bb:mk_bb(Code)), - refresh_state_cache(State#state{cfg = CFG1}). + SLs = [hipe_icode_cfg:start_label(CFG1)], + State#state{cfg = CFG1, succ = CFG1, pred = CFG1, start_labels = SLs}. get_new_catches_in(L, State) -> Ps = get_pred(L, State), diff --git a/lib/hipe/icode/hipe_icode_primops.erl b/lib/hipe/icode/hipe_icode_primops.erl index ffb51b2ea4..84aae30291 100644 --- a/lib/hipe/icode/hipe_icode_primops.erl +++ b/lib/hipe/icode/hipe_icode_primops.erl @@ -116,7 +116,7 @@ is_safe({hipe_bs_primop, {bs_init, _, _}}) -> false; is_safe({hipe_bs_primop, {bs_init_bits, _}}) -> false; is_safe({hipe_bs_primop, {bs_init_bits, _, _}}) -> false; is_safe({hipe_bs_primop, {bs_put_binary, _, _}}) -> false; -is_safe({hipe_bs_primop, {bs_put_binary_all, _}}) -> false; +is_safe({hipe_bs_primop, {bs_put_binary_all, _, _}}) -> false; is_safe({hipe_bs_primop, {bs_put_float, _, _, _}}) -> false; is_safe({hipe_bs_primop, {bs_put_integer, _, _, _}}) -> false; is_safe({hipe_bs_primop, {bs_put_string, _, _}}) -> false; @@ -219,7 +219,7 @@ fails({hipe_bs_primop, {bs_init, _, _}}) -> true; fails({hipe_bs_primop, {bs_init_bits, _}}) -> true; fails({hipe_bs_primop, {bs_init_bits, _, _}}) -> true; fails({hipe_bs_primop, {bs_put_binary, _, _}}) -> true; -fails({hipe_bs_primop, {bs_put_binary_all, _}}) -> true; +fails({hipe_bs_primop, {bs_put_binary_all, _, _}}) -> true; fails({hipe_bs_primop, {bs_put_float, _, _, _}}) -> true; fails({hipe_bs_primop, {bs_put_integer, _, _, _}}) -> true; fails({hipe_bs_primop, {bs_put_string, _, _}}) -> true; @@ -265,8 +265,8 @@ pp(Dev, Op) -> io:format(Dev, "gc_test<~w>", [N]); {hipe_bs_primop, BsOp} -> case BsOp of - {bs_put_binary_all, Flags} -> - io:format(Dev, "bs_put_binary_all<~w>", [Flags]); + {bs_put_binary_all, Unit, Flags} -> + io:format(Dev, "bs_put_binary_all<~w, ~w>", [Unit,Flags]); {bs_put_binary, Size} -> io:format(Dev, "bs_put_binary<~w>", [Size]); {bs_put_binary, Flags, Size} -> @@ -505,11 +505,13 @@ type(Primop, Args) -> NewMatchState = erl_types:t_matchstate_update_present(NewBinType, MatchState), if Signed =:= 0 -> - erl_types:t_product([erl_types:t_from_range(0, 1 bsl Size - 1), + UpperBound = inf_add(safe_bsl(1, Size), -1), + erl_types:t_product([erl_types:t_from_range(0, UpperBound), NewMatchState]); Signed =:= 4 -> - erl_types:t_product([erl_types:t_from_range(- (1 bsl (Size-1)), - (1 bsl (Size-1)) - 1), + erl_types:t_product([erl_types:t_from_range( + inf_inv(safe_bsl(1, Size-1)), + inf_add(safe_bsl(1, Size-1), -1)), NewMatchState]) end; [_Arg] -> @@ -628,8 +630,9 @@ type(Primop, Args) -> [_SrcType, _BitsType, _Base, Type] -> erl_types:t_bitstr_concat(Type, erl_types:t_bitstr(Size, 0)) end; - {hipe_bs_primop, {bs_put_binary_all, _Flags}} -> - [SrcType, _Base, Type] = Args, + {hipe_bs_primop, {bs_put_binary_all, Unit, _Flags}} -> + [SrcType0, _Base, Type] = Args, + SrcType = erl_types:t_inf(erl_types:t_bitstr(Unit, 0), SrcType0), erl_types:t_bitstr_concat(SrcType,Type); {hipe_bs_primop, {bs_put_string, _, Size}} -> [_Base, Type] = Args, @@ -965,3 +968,19 @@ check_fun_args(_, _) -> match_bin(Pattern, Match) -> erl_types:t_bitstr_match(Pattern, Match). + +safe_bsl(0, _) -> 0; +safe_bsl(Base, Shift) when Shift =< 128 -> Base bsl Shift; +safe_bsl(Base, _Shift) when Base > 0 -> pos_inf; +safe_bsl(Base, _Shift) when Base < 0 -> neg_inf. + +inf_inv(pos_inf) -> neg_inf; +inf_inv(neg_inf) -> pos_inf; +inf_inv(Number) -> -Number. + +inf_add(pos_inf, _Number) -> pos_inf; +inf_add(neg_inf, _Number) -> neg_inf; +inf_add(_Number, pos_inf) -> pos_inf; +inf_add(_Number, neg_inf) -> neg_inf; +inf_add(Number1, Number2) when is_integer(Number1), is_integer(Number2) -> + Number1 + Number2. diff --git a/lib/hipe/icode/hipe_icode_range.erl b/lib/hipe/icode/hipe_icode_range.erl index ba5fa1bfd7..9a20527a83 100644 --- a/lib/hipe/icode/hipe_icode_range.erl +++ b/lib/hipe/icode/hipe_icode_range.erl @@ -1202,11 +1202,11 @@ basic_type(#unsafe_update_element{}) -> not_analysed. analyse_bs_get_integer(Size, Flags, true) -> Signed = Flags band 4, if Signed =:= 0 -> - Max = 1 bsl Size - 1, + Max = inf_add(inf_bsl(1, Size), -1), Min = 0; true -> - Max = 1 bsl (Size-1) - 1, - Min = -(1 bsl (Size-1)) + Max = inf_add(inf_bsl(1, Size-1), -1), + Min = inf_inv(inf_bsl(1, Size-1)) end, {Min, Max}; analyse_bs_get_integer(Size, Flags, false) when is_integer(Size), diff --git a/lib/hipe/icode/hipe_icode_ssa_struct_reuse.erl b/lib/hipe/icode/hipe_icode_ssa_struct_reuse.erl index e350a6ff18..7613024787 100644 --- a/lib/hipe/icode/hipe_icode_ssa_struct_reuse.erl +++ b/lib/hipe/icode/hipe_icode_ssa_struct_reuse.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2014. All Rights Reserved. +%% Copyright Ericsson AB 2007-2015. 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. @@ -314,7 +314,7 @@ node_create(Label, Pred, Succ) -> %% tree - the tree of nodes, with labels as keys and node records as values -record(nodes, { - domtree :: hipe_dominators:domTree(), + domtree = none :: 'none' | hipe_dominators:domTree(), labels = none :: 'none' | [icode_lbl()], postorder = none :: 'none' | [icode_lbl()], start_label = none :: 'none' | icode_lbl(), @@ -390,7 +390,7 @@ update_del_red_test_set(Update) -> %%----------------------------------------------------------------------------- %% Main function called from the hipe_main module --spec struct_reuse(#cfg{}) -> #cfg{}. +-spec struct_reuse(cfg()) -> cfg(). struct_reuse(CFG) -> %% debug_init_case_count(?SR_INSTR_TYPE), diff --git a/lib/hipe/main/hipe.erl b/lib/hipe/main/hipe.erl index 1a4bbf179f..0e32da1d36 100644 --- a/lib/hipe/main/hipe.erl +++ b/lib/hipe/main/hipe.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2013. All Rights Reserved. +%% Copyright Ericsson AB 2001-2015. 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. @@ -764,7 +764,8 @@ finalize(OrigList, Mod, Exports, WholeModule, Opts) -> finalize_fun(MfaIcodeList, Exports, Opts) -> case proplists:get_value(concurrent_comp, Opts) of FalseVal when (FalseVal =:= undefined) orelse (FalseVal =:= false) -> - [finalize_fun_sequential(MFAIcode, Opts, #comp_servers{}) + NoServers = #comp_servers{pp_server = none, range = none, type = none}, + [finalize_fun_sequential(MFAIcode, Opts, NoServers) || {_MFA, _Icode} = MFAIcode <- MfaIcodeList]; TrueVal when (TrueVal =:= true) orelse (TrueVal =:= debug) -> finalize_fun_concurrent(MfaIcodeList, Exports, Opts) diff --git a/lib/hipe/main/hipe.hrl.src b/lib/hipe/main/hipe.hrl.src index ba27878a84..3be824ac34 100644 --- a/lib/hipe/main/hipe.hrl.src +++ b/lib/hipe/main/hipe.hrl.src @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2011. All Rights Reserved. +%% Copyright Ericsson AB 2001-2015. 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. @@ -299,7 +299,8 @@ %% Records defined in the hipe module used in other parts of the compiler %%---------------------------------------------------------------------------- --record(comp_servers, {pp_server :: pid(), range :: pid(), type :: pid()}). +-type mpid() :: 'none' | pid(). +-record(comp_servers, {pp_server :: mpid(), range :: mpid(), type :: mpid()}). %%---------------------------------------------------------------------------- %% Basic types of the 'hipe' application used in other parts of the system diff --git a/lib/hipe/main/hipe_main.erl b/lib/hipe/main/hipe_main.erl index 5753169961..be5050e155 100644 --- a/lib/hipe/main/hipe_main.erl +++ b/lib/hipe/main/hipe_main.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2011. All Rights Reserved. +%% Copyright Ericsson AB 2001-2015. 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. @@ -55,7 +55,7 @@ %%===================================================================== %% @spec compile_icode(MFA::mfa(), -%% LinearIcode::#icode{}, +%% LinearIcode::icode(), %% CompilerOptions::comp_options(), %% CompServers::#comp_servers()) -> %% {native,Platform,{unprofiled,NativeCode}} | {rtl,RTLCode} @@ -69,7 +69,7 @@ %% generated). The compiler options must have already been expanded %% (cf. `<a href="hipe.html">hipe:expand_options</a>'). </p> --spec compile_icode(mfa(), #icode{}, comp_options(), #comp_servers{}) -> +-spec compile_icode(mfa(), icode(), comp_options(), #comp_servers{}) -> comp_icode_ret(). compile_icode(MFA, LinearIcode, Options, Servers) -> @@ -230,10 +230,12 @@ get_pp_module(icode_liveness) -> hipe_icode_liveness; get_pp_module(rtl_liveness) -> hipe_rtl_liveness. perform_io(no_fun, _) -> ok; -perform_io(Fun,PPServer) when is_pid(PPServer) -> - PPServer ! {print,Fun}; -perform_io(Fun, undefined) -> - Fun(). +perform_io(Fun, PPServer) when is_pid(PPServer) -> + PPServer ! {print, Fun}, + ok; +perform_io(Fun, none) -> + Fun(), + ok. %%-------------------------------------------------------------------- diff --git a/lib/hipe/rtl/hipe_rtl_arith.inc b/lib/hipe/rtl/hipe_rtl_arith.inc index 1f455f47ed..1dff56b074 100644 --- a/lib/hipe/rtl/hipe_rtl_arith.inc +++ b/lib/hipe/rtl/hipe_rtl_arith.inc @@ -30,13 +30,13 @@ %% Returns a tuple %% {Res, Sign, Zero, Overflow, Carry} %% Res will be a number in the range -%% MAX_SIGNED_INT >= Res >= MIN_SIGNED_INT +%% MAX_UNSIGNED_INT >= Res >= 0 %% The other four values are flags that are either true or false %% eval_alu(Op, Arg1, Arg2) - when Arg1 =< ?MAX_SIGNED_INT, + when Arg1 =< ?MAX_UNSIGNED_INT, Arg1 >= ?MIN_SIGNED_INT, - Arg2 =< ?MAX_SIGNED_INT, + Arg2 =< ?MAX_UNSIGNED_INT, Arg2 >= ?MIN_SIGNED_INT -> Sign1 = sign_bit(Arg1), @@ -111,7 +111,7 @@ eval_alu(Op, Arg1, Arg2) Res = N = Z = V = C = 0, ?EXIT({"unknown alu op", Op}) end, - {two_comp_to_erl(Res), N, Z, V, C}; + {Res, N, Z, V, C}; eval_alu(Op, Arg1, Arg2) -> ?EXIT({argument_overflow,Op,Arg1,Arg2}). @@ -162,16 +162,9 @@ eval_cond(Cond, Arg1, Arg2) -> sign_bit(Val) -> ((Val bsr ?SIGN_BIT) band 1) =:= 1. -two_comp_to_erl(V) -> - if V > ?MAX_SIGNED_INT -> - - ((?MAX_UNSIGNED_INT + 1) - V); - true -> V - end. - shiftmask(Arg) -> Setbits = ?BITS - Arg, (1 bsl Setbits) - 1. zero(Val) -> Val =:= 0. - diff --git a/lib/hipe/rtl/hipe_rtl_arith_32.erl b/lib/hipe/rtl/hipe_rtl_arith_32.erl index 572556be1c..d790a8b981 100644 --- a/lib/hipe/rtl/hipe_rtl_arith_32.erl +++ b/lib/hipe/rtl/hipe_rtl_arith_32.erl @@ -24,7 +24,8 @@ %% Filename : hipe_rtl_arith_32.erl %% Module : hipe_rtl_arith_32 %% Purpose : To implement 32-bit RTL-arithmetic -%% Notes : The arithmetic works on 32-bit signed integers. +%% Notes : The arithmetic works on 32-bit signed and unsigned +%% integers. %% The implementation is taken from the implementation %% of arithmetic on SPARC. %% XXX: This code is seldom used, and hence also diff --git a/lib/hipe/rtl/hipe_rtl_binary.erl b/lib/hipe/rtl/hipe_rtl_binary.erl index b549073050..9cbab08ee2 100644 --- a/lib/hipe/rtl/hipe_rtl_binary.erl +++ b/lib/hipe/rtl/hipe_rtl_binary.erl @@ -1,3 +1,4 @@ +%% -*- erlang-indent-level: 2 -*- %%% %%% %CopyrightBegin% %%% @@ -28,11 +29,20 @@ -export([gen_rtl/7]). +-export([floorlog2/1, get_word_integer/4, make_size/3, make_size/4]). + +%%-------------------------------------------------------------------- + +-define(BYTE_SHIFT, 3). %% Turn bits into bytes or vice versa +-define(BYTE_SIZE, 8). + +%%-------------------------------------------------------------------- + gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SysLimName, ConstTab) -> case type_of_operation(BsOP) of match -> {hipe_rtl_binary_match:gen_rtl( - BsOP, Dst, Args, TrueLblName, FalseLblName),ConstTab}; + BsOP, Dst, Args, TrueLblName, FalseLblName),ConstTab}; construct -> hipe_rtl_binary_construct:gen_rtl( BsOP, Dst, Args, TrueLblName, FalseLblName, SysLimName, ConstTab) @@ -62,7 +72,7 @@ type_of_operation({bs_init,_,_}) -> construct; type_of_operation({bs_init_bits,_}) -> construct; type_of_operation({bs_init_bits,_,_}) -> construct; type_of_operation({bs_put_binary,_,_}) -> construct; -type_of_operation({bs_put_binary_all,_}) -> construct; +type_of_operation({bs_put_binary_all,_,_}) -> construct; type_of_operation({bs_put_float,_,_,_}) -> construct; type_of_operation({bs_put_integer,_,_,_}) -> construct; type_of_operation({bs_put_string,_,_}) -> construct; @@ -79,3 +89,133 @@ type_of_operation(bs_final) -> construct; type_of_operation({bs_append,_,_,_,_}) -> construct; type_of_operation({bs_private_append,_,_}) -> construct; type_of_operation(bs_init_writable) -> construct. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% Small utility functions: +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +create_lbls(X) when X > 0 -> + [hipe_rtl:mk_new_label()|create_lbls(X-1)]; +create_lbls(0) -> + []. + +%%------------------------------------------------------------------------------ +%% Utilities used by both hipe_rtl_binary_construct and hipe_rtl_binary_match +%%------------------------------------------------------------------------------ + +get_word_integer(Var, Register, SystemLimitLblName, FalseLblName) -> + [EndLbl] = create_lbls(1), + EndName = hipe_rtl:label_name(EndLbl), + get_word_integer(Var, Register,SystemLimitLblName, FalseLblName, EndName, EndName, + [EndLbl]). + +get_word_integer(Var, Register, SystemLimitLblName, FalseLblName, TrueLblName, + BigLblName, Tail) -> + [FixnumLbl, NotFixnumLbl, BignumLbl, SuccessLbl] = create_lbls(4), + [hipe_tagscheme:test_fixnum(Var, hipe_rtl:label_name(FixnumLbl), + hipe_rtl:label_name(NotFixnumLbl), 0.99), + FixnumLbl, + hipe_tagscheme:fixnum_ge(Var, hipe_rtl:mk_imm(hipe_tagscheme:mk_fixnum(0)), + hipe_rtl:label_name(SuccessLbl), FalseLblName, + 0.99), + SuccessLbl, + hipe_tagscheme:untag_fixnum(Register, Var), + hipe_rtl:mk_goto(TrueLblName), + NotFixnumLbl, + hipe_tagscheme:test_pos_bignum_arity(Var, 1, hipe_rtl:label_name(BignumLbl), + FalseLblName, SystemLimitLblName, 0.99), + BignumLbl, + hipe_tagscheme:unsafe_get_one_word_pos_bignum(Register, Var), + hipe_rtl:mk_goto(BigLblName) | Tail]. + +make_size(UnitImm, BitsVar, FailLblName) -> + make_size(UnitImm, BitsVar, FailLblName, FailLblName). + +make_size(1, BitsVar, OverflowLblName, FalseLblName) -> + DstReg = hipe_rtl:mk_new_reg_gcsafe(), + {get_word_integer(BitsVar, DstReg, OverflowLblName, FalseLblName), DstReg}; +make_size(?BYTE_SIZE, BitsVar, OverflowLblName, FalseLblName) -> + DstReg = hipe_rtl:mk_new_reg_gcsafe(), + [FixnumLbl, BignumLbl] = create_lbls(2), + WordBits = hipe_rtl_arch:word_size() * ?BYTE_SIZE, + FixnumLblName = hipe_rtl:label_name(FixnumLbl), + Tail = [BignumLbl, + hipe_rtl:mk_branch(DstReg, 'ltu', + hipe_rtl:mk_imm(1 bsl (WordBits - ?BYTE_SHIFT)), + FixnumLblName, OverflowLblName, 0.99), + FixnumLbl, + hipe_rtl:mk_alu(DstReg, DstReg, sll, hipe_rtl:mk_imm(?BYTE_SHIFT))], + Code = get_word_integer(BitsVar, DstReg, OverflowLblName, FalseLblName, + FixnumLblName, hipe_rtl:label_name(BignumLbl), Tail), + {Code, DstReg}; +make_size(UnitImm, BitsVar, OverflowLblName, FalseLblName) -> + DstReg = hipe_rtl:mk_new_reg_gcsafe(), + UnitList = number2list(UnitImm), + Code = multiply_code(UnitList, BitsVar, DstReg, OverflowLblName, FalseLblName), + {Code, DstReg}. + +multiply_code(List=[Head|_Tail], Variable, Result, OverflowLblName, + FalseLblName) -> + Test = set_high(Head), + Tmp1 = hipe_rtl:mk_new_reg(), + SuccessLbl = hipe_rtl:mk_new_label(), + Register = hipe_rtl:mk_new_reg(), + Code = [hipe_rtl:mk_move(Result, hipe_rtl:mk_imm(0))| + get_word_integer(Variable, Register, OverflowLblName, FalseLblName)] + ++ + [hipe_rtl:mk_alub(Tmp1, Register, 'and', hipe_rtl:mk_imm(Test), + eq, hipe_rtl:label_name(SuccessLbl), + OverflowLblName, 0.99), + SuccessLbl], + multiply_code(List, Register, Result, OverflowLblName, Tmp1, Code). + +multiply_code([ShiftSize|Rest], Register, Result, OverflowLblName, Tmp1, + OldCode) -> + SuccessLbl = hipe_rtl:mk_new_label(), + Code = + OldCode ++ + [hipe_rtl:mk_alu(Tmp1, Register, sll, hipe_rtl:mk_imm(ShiftSize)), + hipe_rtl:mk_alub(Result, Tmp1, 'add', Result, not_overflow, + hipe_rtl:label_name(SuccessLbl), OverflowLblName, 0.99), + SuccessLbl], + multiply_code(Rest, Register, Result, OverflowLblName, Tmp1, Code); +multiply_code([], _Register, _Result, _OverflowLblName, _Tmp1, Code) -> + Code. + +set_high(X) -> + WordBits = hipe_rtl_arch:word_size() * ?BYTE_SIZE, + set_high(min(X, WordBits), WordBits, 0). + +set_high(0, _, Y) -> + Y; +set_high(X, WordBits, Y) -> + set_high(X-1, WordBits, Y+(1 bsl (WordBits-X))). + + +number2list(X) when is_integer(X), X >= 0 -> + number2list(X, []). + +number2list(1, Acc) -> + lists:reverse([0|Acc]); +number2list(0, Acc) -> + lists:reverse(Acc); +number2list(X, Acc) -> + F = floorlog2(X), + number2list(X-(1 bsl F), [F|Acc]). + +floorlog2(X) -> + %% Double-precision floats do not have enough precision to make floorlog2 + %% exact for integers larger than 2^47. + Approx = round(math:log(X)/math:log(2)-0.5), + floorlog2_refine(X, Approx). + +floorlog2_refine(X, Approx) -> + if (1 bsl Approx) > X -> + floorlog2_refine(X, Approx - 1); + (1 bsl (Approx+1)) > X -> + Approx; + true -> + floorlog2_refine(X, Approx + 1) + end. diff --git a/lib/hipe/rtl/hipe_rtl_binary_construct.erl b/lib/hipe/rtl/hipe_rtl_binary_construct.erl index 692bad7d96..4403aa552f 100644 --- a/lib/hipe/rtl/hipe_rtl_binary_construct.erl +++ b/lib/hipe/rtl/hipe_rtl_binary_construct.erl @@ -34,6 +34,10 @@ get_field_from_term/3, set_field_from_pointer/3, get_field_from_pointer/3]). + +-import(hipe_rtl_binary, [floorlog2/1, + get_word_integer/4, + make_size/4]). %%------------------------------------------------------------------------- -include("../main/hipe.hrl"). @@ -94,10 +98,11 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab var_init_bits(Size, Dst0, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName); - {bs_put_binary_all, _Flags} -> + {bs_put_binary_all, Unit, _Flags} -> [Src, Base, Offset] = Args, [NewOffset] = get_real(Dst), - put_binary_all(NewOffset, Src, Base, Offset, TrueLblName, FalseLblName); + put_binary_all(NewOffset, Src, Base, Offset, Unit, + TrueLblName, FalseLblName); {bs_put_binary, Size, _Flags} -> case is_illegal_const(Size) of @@ -110,7 +115,9 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab put_static_binary(NewOffset, Src, Size, Base, Offset, TrueLblName, FalseLblName); [Src, Bits, Base, Offset] -> - {SizeCode, SizeReg} = make_size(Size, Bits, FalseLblName), + {SizeCode, SizeReg} = make_size(Size, Bits, + SystemLimitLblName, + FalseLblName), InCode = put_dynamic_binary(NewOffset, Src, SizeReg, Base, Offset, TrueLblName, FalseLblName), SizeCode ++ InCode @@ -132,7 +139,9 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab put_float(NewOffset, Src, Base, Offset, Size, CCode, Aligned, LittleEndian, ConstInfo, TrueLblName); [Src, Bits, Base, Offset] -> - {SizeCode, SizeReg} = make_size(Size, Bits, FalseLblName), + {SizeCode, SizeReg} = make_size(Size, Bits, + SystemLimitLblName, + FalseLblName), InCode = float_c_code(NewOffset, Src, Base, Offset, SizeReg, Flags, TrueLblName, FalseLblName), SizeCode ++ InCode @@ -161,6 +170,7 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab CCode, Aligned, LittleEndian, TrueLblName); [Src, Bits, Base, Offset] -> {SizeCode, SizeReg} = make_size(Size, Bits, + SystemLimitLblName, FalseLblName), CCode = int_c_code(NewOffset, Src, Base, Offset, SizeReg, Flags, @@ -209,6 +219,7 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab TrueLblName); [Src, Bits, Base, Offset] -> {SizeCode, SizeReg} = make_size(Size, Bits, + SystemLimitLblName, FalseLblName), CCode = int_c_code(NewOffset, Src, Base, Offset, SizeReg, Flags, @@ -293,7 +304,7 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab [SizeReg] = create_regs(1), [Base] = create_unsafe_regs(1), [hipe_rtl:mk_gctest(?PROC_BIN_WORDSIZE + ?SUB_BIN_WORDSIZE), - check_and_untag_fixnum(Size, SizeReg, FalseLblName), + get_word_integer(Size, SizeReg, SystemLimitLblName, FalseLblName), allocate_writable(DstVar, Base, SizeReg, Zero, Zero), hipe_rtl:mk_goto(TrueLblName)]; @@ -305,7 +316,7 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab SubBinSize = {sub_binary, binsize}, [get_field_from_term({sub_binary, orig}, Bin, ProcBin), get_field_from_term(SubBinSize, Bin, SubSize), - check_and_untag_fixnum(Size, SizeReg, FalseLblName), + get_word_integer(Size, SizeReg, SystemLimitLblName, FalseLblName), realloc_binary(SizeReg, ProcBin, Base), calculate_sizes(Bin, SizeReg, Offset, EndSubSize, EndSubBitSize), set_field_from_term(SubBinSize, Bin, EndSubSize), @@ -313,20 +324,21 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab hipe_rtl:mk_move(DstVar, Bin), hipe_rtl:mk_goto(TrueLblName)]; - {bs_append, _U, _F, _B, _Bla} -> + {bs_append, _U, _F, Unit, _Bla} -> [Size, Bin] = Args, [DstVar, Base, Offset] = Dst, [ProcBin] = create_vars(1), [Flags, SizeReg, IsWritable, EndSubSize, EndSubBitSize] = create_regs(5), - [ContLbl,ContLbl2,ContLbl3,WritableLbl,NotWritableLbl] = Lbls = - create_lbls(5), - [ContLblName, ContLbl2Name, ContLbl3Name, Writable, NotWritable] = + [ContLbl,ContLbl2,ContLbl3,ContLbl4,WritableLbl,NotWritableLbl] = + Lbls = create_lbls(6), + [ContLblName, ContLbl2Name, ContLbl3Name, ContLbl4Name, + Writable, NotWritable] = [hipe_rtl:label_name(Lbl) || Lbl <- Lbls], Zero = hipe_rtl:mk_imm(0), SubIsWritable = {sub_binary, is_writable}, [hipe_rtl:mk_gctest(?SUB_BIN_WORDSIZE + ?PROC_BIN_WORDSIZE), - check_and_untag_fixnum(Size, SizeReg, FalseLblName), + get_word_integer(Size, SizeReg, SystemLimitLblName, FalseLblName), hipe_tagscheme:test_bitstr(Bin, ContLblName, FalseLblName, 0.99), ContLbl, hipe_tagscheme:test_subbinary(Bin,ContLbl2Name, NotWritable), @@ -339,17 +351,19 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab get_field_from_term({proc_bin, flags}, ProcBin, Flags), hipe_rtl:mk_alub(Flags, Flags, 'and', hipe_rtl:mk_imm(?PB_IS_WRITABLE), - eq, NotWritable, Writable, 0.01), + eq, NotWritable, ContLbl4Name, 0.01), + ContLbl4, + calculate_sizes(Bin, SizeReg, Offset, EndSubSize, EndSubBitSize), + is_divisible(Offset, Unit, Writable, FalseLblName), WritableLbl, set_field_from_term(SubIsWritable, Bin, Zero), realloc_binary(SizeReg, ProcBin, Base), - calculate_sizes(Bin, SizeReg, Offset, EndSubSize, EndSubBitSize), hipe_tagscheme:mk_sub_binary(DstVar, EndSubSize, Zero, EndSubBitSize, Zero, hipe_rtl:mk_imm(1), ProcBin), hipe_rtl:mk_goto(TrueLblName), NotWritableLbl, - not_writable_code(Bin, SizeReg, DstVar, Base, Offset, + not_writable_code(Bin, SizeReg, DstVar, Base, Offset, Unit, TrueLblName, FalseLblName)] end, {Code, ConstTab} @@ -361,7 +375,7 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -not_writable_code(Bin, SizeReg, Dst, Base, Offset, +not_writable_code(Bin, SizeReg, Dst, Base, Offset, Unit, TrueLblName, FalseLblName) -> [SrcBase] = create_unsafe_regs(1), [SrcOffset, SrcSize, TotSize, TotBytes, UsedBytes] = create_regs(5), @@ -372,13 +386,13 @@ not_writable_code(Bin, SizeReg, Dst, Base, Offset, hipe_rtl:mk_alu(TotBytes, TotSize, add, ?LOW_BITS), hipe_rtl:mk_alu(TotBytes, TotBytes, srl, ?BYTE_SHIFT), hipe_rtl:mk_alu(UsedBytes, TotBytes, sll, hipe_rtl:mk_imm(1)), - hipe_rtl:mk_branch(UsedBytes, ge, hipe_rtl:mk_imm(256), + hipe_rtl:mk_branch(UsedBytes, geu, hipe_rtl:mk_imm(256), AllLblName, IncLblName), IncLbl, hipe_rtl:mk_move(UsedBytes, hipe_rtl:mk_imm(256)), AllLbl, allocate_writable(Dst, Base, UsedBytes, TotBytes, TotSize), - put_binary_all(Offset, Bin, Base, hipe_rtl:mk_imm(0), + put_binary_all(Offset, Bin, Base, hipe_rtl:mk_imm(0), Unit, TrueLblName, FalseLblName)]. allocate_writable(Dst, Base, UsedBytes, TotBytes, TotSize) -> @@ -397,16 +411,6 @@ allocate_writable(Dst, Base, UsedBytes, TotBytes, TotSize) -> hipe_tagscheme:mk_sub_binary(Dst, EndSubSize, Zero, EndSubBitSize, Zero, hipe_rtl:mk_imm(1), ProcBin)]. -check_and_untag_fixnum(Size, SizeReg, FalseLblName) -> - [ContLbl,NextLbl] = Lbls = create_lbls(2), - [ContLblName,NextLblName] = get_label_names(Lbls), - [hipe_tagscheme:test_fixnum(Size, ContLblName, FalseLblName, 0.99), - ContLbl, - hipe_tagscheme:untag_fixnum(SizeReg,Size), - hipe_rtl:mk_branch(SizeReg, ge, hipe_rtl:mk_imm(0), NextLblName, - FalseLblName), - NextLbl]. - realloc_binary(SizeReg, ProcBin, Base) -> [NoReallocLbl, ReallocLbl, NextLbl, ContLbl] = Lbls = create_lbls(4), [NoReallocLblName, ReallocLblName, NextLblName, ContLblName] = @@ -428,7 +432,7 @@ realloc_binary(SizeReg, ProcBin, Base) -> set_field_from_term(ProcBinFlagsTag, ProcBin, Flags), get_field_from_term(ProcBinValTag, ProcBin, BinPointer), get_field_from_pointer(BinOrigSizeTag, BinPointer, OrigSize), - hipe_rtl:mk_branch(OrigSize, 'lt', ResultingSize, + hipe_rtl:mk_branch(OrigSize, 'ltu', ResultingSize, ReallocLblName, NoReallocLblName), NoReallocLbl, get_field_from_term(ProcBinBytesTag, ProcBin, Base), @@ -669,14 +673,14 @@ var_init2(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName WordSize = hipe_rtl_arch:word_size(), [ContLbl,HeapLbl,REFCLbl,NextLbl] = create_lbls(4), [USize,Tmp] = create_unsafe_regs(2), - [get_32_bit_value(Size, USize, SystemLimitLblName, FalseLblName), - hipe_rtl:mk_branch(USize, le, hipe_rtl:mk_imm(?MAX_BINSIZE), - hipe_rtl:label_name(ContLbl), - SystemLimitLblName), + [get_word_integer(Size, USize, SystemLimitLblName, FalseLblName), + hipe_rtl:mk_branch(USize, leu, hipe_rtl:mk_imm(?MAX_BINSIZE), + hipe_rtl:label_name(ContLbl), + SystemLimitLblName), ContLbl, hipe_rtl:mk_move(Offset, hipe_rtl:mk_imm(0)), - hipe_rtl:mk_branch(USize, le, hipe_rtl:mk_imm(?MAX_HEAP_BIN_SIZE), - hipe_rtl:label_name(HeapLbl), + hipe_rtl:mk_branch(USize, leu, hipe_rtl:mk_imm(?MAX_HEAP_BIN_SIZE), + hipe_rtl:label_name(HeapLbl), hipe_rtl:label_name(REFCLbl)), HeapLbl, hipe_rtl:mk_alu(Tmp, USize, add, hipe_rtl:mk_imm(3*WordSize-1)), @@ -694,8 +698,8 @@ var_init2(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName hipe_rtl:mk_goto(TrueLblName)]. var_init_bits(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName) -> - [HeapLbl,REFCLbl,NextLbl,NoSubLbl,SubLbl,ContLbl, - NoCreateSubBin, CreateSubBin, JoinLbl, JoinLbl2] = create_lbls(10), + [HeapLbl,REFCLbl,NextLbl,NoSubLbl,SubLbl, + NoCreateSubBin, CreateSubBin, JoinLbl, JoinLbl2] = create_lbls(9), [USize,ByteSize,TotByteSize,OffsetBits] = create_regs(4), [TmpDst] = create_unsafe_regs(1), Log2WordSize = hipe_rtl_arch:log2_word_size(), @@ -705,7 +709,7 @@ var_init_bits(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLbl ?PROC_BIN_WORDSIZE) + ?SUB_BIN_WORDSIZE, Zero = hipe_rtl:mk_imm(0), [hipe_rtl:mk_gctest(MaximumWords), - get_32_bit_value(Size, USize, SystemLimitLblName, FalseLblName), + get_word_integer(Size, USize, SystemLimitLblName, FalseLblName), hipe_rtl:mk_alu(ByteSize, USize, srl, ?BYTE_SHIFT), hipe_rtl:mk_alub(OffsetBits, USize, 'and', ?LOW_BITS, eq, hipe_rtl:label_name(NoSubLbl), @@ -716,11 +720,7 @@ var_init_bits(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLbl SubLbl, hipe_rtl:mk_alu(TotByteSize, ByteSize, 'add', hipe_rtl:mk_imm(1)), JoinLbl, - hipe_rtl:mk_branch(USize, le, hipe_rtl:mk_imm(?MAX_BINSIZE), - hipe_rtl:label_name(ContLbl), - SystemLimitLblName), - ContLbl, - hipe_rtl:mk_branch(TotByteSize, 'le', hipe_rtl:mk_imm(?MAX_HEAP_BIN_SIZE), + hipe_rtl:mk_branch(TotByteSize, 'leu', hipe_rtl:mk_imm(?MAX_HEAP_BIN_SIZE), hipe_rtl:label_name(HeapLbl), hipe_rtl:label_name(REFCLbl)), HeapLbl, @@ -743,13 +743,16 @@ var_init_bits(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLbl hipe_rtl:mk_move(Dst, TmpDst), hipe_rtl:mk_goto(TrueLblName)]. -put_binary_all(NewOffset, Src, Base, Offset, TLName, FLName) -> +put_binary_all(NewOffset, Src, Base, Offset, Unit, TLName, FLName) -> [SrcBase,SrcOffset,NumBits] = create_regs(3), + [ContLbl] = create_lbls(1), CCode = binary_c_code(NewOffset, Src, Base, Offset, NumBits, TLName), AlignedCode = copy_aligned_bytes(SrcBase, SrcOffset, NumBits, Base, Offset, NewOffset, TLName), - get_base_offset_size(Src, SrcBase, SrcOffset, NumBits,FLName) ++ - test_alignment(SrcOffset, NumBits, Offset, AlignedCode, CCode). + [get_base_offset_size(Src, SrcBase, SrcOffset, NumBits,FLName), + is_divisible(NumBits, Unit, hipe_rtl:label_name(ContLbl), FLName), + ContLbl + |test_alignment(SrcOffset, NumBits, Offset, AlignedCode, CCode)]. test_alignment(SrcOffset, NumBits, Offset, AlignedCode, CCode) -> [Tmp] = create_regs(1), @@ -976,7 +979,7 @@ copy_string(StringBase, StringSize, BinBase, BinOffset, NewOffset, TrueLblName) small_check(SizeVar, CopySize, FalseLblName) -> SuccessLbl = hipe_rtl:mk_new_label(), - [hipe_rtl:mk_branch(SizeVar, le, CopySize, + [hipe_rtl:mk_branch(SizeVar, leu, CopySize, hipe_rtl:label_name(SuccessLbl), FalseLblName), SuccessLbl]. @@ -1279,89 +1282,18 @@ copy_float_big(Base, Offset, NewOffset, Src, FalseLblName, TrueLblName, var) -> hipe_tagscheme:test_flonum(Src, hipe_rtl:label_name(SuccessLbl), FalseLblName, 0.99) ++ [SuccessLbl|copy_float_big(Base, Offset, NewOffset, Src, FalseLblName, TrueLblName, pass)]. -make_size(1, BitsVar, FalseLblName) -> - [DstReg] = create_regs(1), - {first_part(BitsVar, DstReg, FalseLblName), DstReg}; -make_size(?BYTE_SIZE, BitsVar, FalseLblName) -> - [DstReg] = create_regs(1), - Code = - first_part(BitsVar, DstReg, FalseLblName) ++ - [hipe_rtl:mk_alu(DstReg, DstReg, 'sll', ?BYTE_SHIFT)], - {Code, DstReg}; -make_size(UnitImm, BitsVar, FalseLblName) -> - [DstReg] = create_regs(1), - UnitList = number2list(UnitImm), - Code = multiply_code(UnitList, BitsVar, DstReg, FalseLblName), - {Code, DstReg}. - -multiply_code(List=[Head|_Tail], Variable, Result, FalseLblName) -> - Test = set_high(Head), - Tmp1 = hipe_rtl:mk_new_reg(), - SuccessLbl = hipe_rtl:mk_new_label(), - Register = hipe_rtl:mk_new_reg(), - Code = [hipe_rtl:mk_move(Result, hipe_rtl:mk_imm(0))| - first_part(Variable, Register, FalseLblName)] - ++ - [hipe_rtl:mk_alub(Tmp1, Register, 'and', hipe_rtl:mk_imm(Test), - 'eq', hipe_rtl:label_name(SuccessLbl), - FalseLblName, 0.99), - SuccessLbl], - multiply_code(List, Register, Result, FalseLblName, Tmp1, Code). - -multiply_code([ShiftSize|Rest], Register, Result, FalseLblName, Tmp1, OldCode) -> - SuccessLbl = hipe_rtl:mk_new_label(), - Code = OldCode ++ [hipe_rtl:mk_alu(Tmp1, Register, 'sll', - hipe_rtl:mk_imm(ShiftSize)), - hipe_rtl:mk_alub(Result, Tmp1, 'add', Result, not_overflow, hipe_rtl:label_name(SuccessLbl), FalseLblName, 0.99), - SuccessLbl], - multiply_code(Rest, Register, Result, FalseLblName, Tmp1, Code); -multiply_code([], _Register, _Result, _FalseLblName, _Tmp1, Code) -> - Code. - -number2list(X) when is_integer(X), X >= 0 -> - number2list(X, []). - -number2list(1, Acc) -> - lists:reverse([0|Acc]); -number2list(0, Acc) -> - lists:reverse(Acc); -number2list(X, Acc) -> - F = floorlog2(X), - number2list(X-(1 bsl F), [F|Acc]). - -floorlog2(X) -> - round(math:log(X)/math:log(2)-0.5). - -set_high(X) -> - set_high(X, 0). - -set_high(0, Y) -> - Y; -set_high(X, Y) -> - set_high(X-1, Y+(1 bsl (27-X))). - -get_32_bit_value(Size, USize, SystemLimitLblName, NegLblName) -> - Lbls = [FixLbl, BigLbl, OkLbl, PosBigLbl] = create_lbls(4), - [FixLblName, BigLblName, OkLblName, PosBigLblName] = [hipe_rtl:label_name(Lbl) || Lbl <- Lbls], - [hipe_tagscheme:test_fixnum(Size, FixLblName, BigLblName, 0.99), - FixLbl, - hipe_tagscheme:untag_fixnum(USize, Size), - hipe_rtl:mk_branch(USize, ge, hipe_rtl:mk_imm(0), OkLblName, NegLblName), - BigLbl, - hipe_tagscheme:test_pos_bignum(Size, PosBigLblName, NegLblName, 0.99), - PosBigLbl, - hipe_tagscheme:get_one_word_pos_bignum(USize, Size, SystemLimitLblName), - OkLbl]. - - -first_part(Var, Register, FalseLblName) -> - [SuccessLbl1, SuccessLbl2] = create_lbls(2), - [hipe_tagscheme:test_fixnum(Var, hipe_rtl:label_name(SuccessLbl1), - FalseLblName, 0.99), - SuccessLbl1, - hipe_tagscheme:fixnum_ge(Var, hipe_rtl:mk_imm(hipe_tagscheme:mk_fixnum(0)), - hipe_rtl:label_name(SuccessLbl2), FalseLblName, 0.99), - SuccessLbl2, - hipe_tagscheme:untag_fixnum(Register, Var)]. - - +is_divisible(_Dividend, 1, SuccLbl, _FailLbl) -> + [hipe_rtl:mk_goto(SuccLbl)]; +is_divisible(Dividend, Divisor, SuccLbl, FailLbl) -> + Log2 = floorlog2(Divisor), + case Divisor =:= 1 bsl Log2 of + true -> %% Divisor is a power of 2 + %% Test that the Log2-1 lowest bits are clear + Mask = hipe_rtl:mk_imm(Divisor - 1), + [Tmp] = create_regs(1), + [hipe_rtl:mk_alub(Tmp, Dividend, 'and', Mask, eq, SuccLbl, FailLbl, 0.99)]; + false -> + %% We need division, fall back to a primop + [hipe_rtl:mk_call([], is_divisible, [Dividend, hipe_rtl:mk_imm(Divisor)], + SuccLbl, FailLbl, not_remote)] + end. diff --git a/lib/hipe/rtl/hipe_rtl_binary_match.erl b/lib/hipe/rtl/hipe_rtl_binary_match.erl index 51213b71d1..be4c35dae0 100644 --- a/lib/hipe/rtl/hipe_rtl_binary_match.erl +++ b/lib/hipe/rtl/hipe_rtl_binary_match.erl @@ -31,11 +31,12 @@ -import(hipe_tagscheme, [set_field_from_term/3, get_field_from_term/3]). +-import(hipe_rtl_binary, [make_size/3]). + -include("hipe_literals.hrl"). %%-------------------------------------------------------------------- --define(MAX_BINSIZE, trunc(?MAX_HEAP_BIN_SIZE / hipe_rtl_arch:word_size()) + 2). -define(BYTE_SHIFT, 3). %% Turn bits into bytes or vice versa -define(LOW_BITS, 7). %% Three lowest bits set -define(BYTE_SIZE, 8). @@ -333,32 +334,50 @@ float_get_c_code(Dst1, Ms, Size, Flags, TrueLblName, FalseLblName) -> get_c_code(Func, Dst1, Ms, Size, Flags, TrueLblName, FalseLblName) -> SizeReg = hipe_rtl:mk_new_reg_gcsafe(), FlagsReg = hipe_rtl:mk_new_reg_gcsafe(), + RetReg = hipe_rtl:mk_new_reg_gcsafe(), MatchBuf = hipe_rtl:mk_new_reg(), RetLabel = hipe_rtl:mk_new_label(), + OkLabel = hipe_rtl:mk_new_label(), NonVal = hipe_rtl:mk_imm(hipe_tagscheme:mk_non_value()), [hipe_rtl:mk_move(SizeReg, Size), hipe_rtl:mk_move(FlagsReg, hipe_rtl:mk_imm(Flags)), hipe_tagscheme:extract_matchbuffer(MatchBuf, Ms), - hipe_rtl_arch:call_bif([Dst1], Func, [SizeReg, FlagsReg, MatchBuf], + hipe_rtl_arch:call_bif([RetReg], Func, [SizeReg, FlagsReg, MatchBuf], hipe_rtl:label_name(RetLabel), FalseLblName), RetLabel, - hipe_rtl:mk_branch(Dst1, eq, NonVal, FalseLblName, TrueLblName, 0.01)]. + hipe_rtl:mk_branch(RetReg, eq, NonVal, FalseLblName, + hipe_rtl:label_name(OkLabel), 0.01), + OkLabel, + hipe_rtl:mk_move(Dst1, RetReg), + hipe_rtl:mk_goto(TrueLblName)]. utf8_get_c_code(Dst, Ms, TrueLblName, FalseLblName) -> + RetReg = hipe_rtl:mk_new_reg_gcsafe(), + OkLabel = hipe_rtl:mk_new_label(), MatchBuf = hipe_rtl:mk_new_reg(), NonVal = hipe_rtl:mk_imm(hipe_tagscheme:mk_non_value()), [hipe_tagscheme:extract_matchbuffer(MatchBuf, Ms), - hipe_rtl_arch:call_bif([Dst], bs_get_utf8, [MatchBuf], [], []), - hipe_rtl:mk_branch(Dst, eq, NonVal, FalseLblName, TrueLblName, 0.01)]. + hipe_rtl_arch:call_bif([RetReg], bs_get_utf8, [MatchBuf], [], []), + hipe_rtl:mk_branch(RetReg, eq, NonVal, FalseLblName, + hipe_rtl:label_name(OkLabel), 0.01), + OkLabel, + hipe_rtl:mk_move(Dst, RetReg), + hipe_rtl:mk_goto(TrueLblName)]. utf16_get_c_code(Flags, Dst, Ms, TrueLblName, FalseLblName) -> + RetReg = hipe_rtl:mk_new_reg_gcsafe(), + OkLabel = hipe_rtl:mk_new_label(), MatchBuf = hipe_rtl:mk_new_reg(), NonVal = hipe_rtl:mk_imm(hipe_tagscheme:mk_non_value()), FlagsReg = hipe_rtl:mk_new_reg_gcsafe(), [hipe_tagscheme:extract_matchbuffer(MatchBuf, Ms), hipe_rtl:mk_move(FlagsReg, hipe_rtl:mk_imm(Flags)), - hipe_rtl_arch:call_bif([Dst], bs_get_utf16, [MatchBuf, FlagsReg], [], []), - hipe_rtl:mk_branch(Dst, eq, NonVal, FalseLblName, TrueLblName, 0.01)]. + hipe_rtl_arch:call_bif([RetReg], bs_get_utf16, [MatchBuf, FlagsReg], [], []), + hipe_rtl:mk_branch(RetReg, eq, NonVal, FalseLblName, + hipe_rtl:label_name(OkLabel), 0.01), + OkLabel, + hipe_rtl:mk_move(Dst, RetReg), + hipe_rtl:mk_goto(TrueLblName)]. validate_unicode_retract_c_code(Src, Ms, TrueLblName, FalseLblName) -> MatchBuf = hipe_rtl:mk_new_reg(), @@ -817,10 +836,10 @@ create_lbls(0) -> create_lbls(X) when X > 0 -> [hipe_rtl:mk_new_label()|create_lbls(X-1)]. -make_dyn_prep(SizeReg, CCode) -> +make_dyn_prep(SizeReg, CCode) -> [CLbl, SuccessLbl] = create_lbls(2), - Init = [hipe_rtl:mk_branch(SizeReg, le, hipe_rtl:mk_imm(?MAX_SMALL_BITS), - hipe_rtl:label_name(SuccessLbl), + Init = [hipe_rtl:mk_branch(SizeReg, leu, hipe_rtl:mk_imm(?MAX_SMALL_BITS), + hipe_rtl:label_name(SuccessLbl), hipe_rtl:label_name(CLbl)), SuccessLbl], End = [CLbl|CCode], @@ -865,8 +884,8 @@ get_unaligned_int_to_reg(Reg, Size, Base, Offset, LowBits, Shiftr, Type) -> hipe_rtl:mk_imm((WordSize-MinLoad)*?BYTE_SIZE))]; {_, WordSize} -> UnsignedBig = {unsigned, big}, - [hipe_rtl:mk_branch(TotBits, le, hipe_rtl:mk_imm(MinLoad*?BYTE_SIZE), - hipe_rtl:label_name(LessLbl), + [hipe_rtl:mk_branch(TotBits, leu, hipe_rtl:mk_imm(MinLoad*?BYTE_SIZE), + hipe_rtl:label_name(LessLbl), hipe_rtl:label_name(MoreLbl)), LessLbl, load_bytes(LoadDst, Base, ByteOffset, Type, MinLoad), @@ -926,7 +945,7 @@ get_big_unknown_int(Dst1, Base, Offset, NewOffset, hipe_rtl:mk_alu(ByteOffset, Offset, srl, hipe_rtl:mk_imm(?BYTE_SHIFT)), load_bytes(LoadDst, Base, ByteOffset, Type, 1), BackLbl, - hipe_rtl:mk_branch(ByteOffset, le, Limit, hipe_rtl:label_name(LoopLbl), + hipe_rtl:mk_branch(ByteOffset, leu, Limit, hipe_rtl:label_name(LoopLbl), hipe_rtl:label_name(EndLbl)), LoopLbl, load_bytes(Tmp, Base, ByteOffset, {unsigned, big}, 1), @@ -955,8 +974,8 @@ get_little_unknown_int(Dst1, Base, Offset, NewOffset, hipe_rtl:mk_alu(Limit, Tmp, srl, hipe_rtl:mk_imm(?BYTE_SHIFT)), hipe_rtl:mk_move(ShiftReg, hipe_rtl:mk_imm(0)), BackLbl, - hipe_rtl:mk_branch(ByteOffset, lt, Limit, - hipe_rtl:label_name(LoopLbl), + hipe_rtl:mk_branch(ByteOffset, ltu, Limit, + hipe_rtl:label_name(LoopLbl), hipe_rtl:label_name(DoneLbl)), LoopLbl, load_bytes(Tmp, Base, ByteOffset, {unsigned, big}, 1), @@ -1072,7 +1091,7 @@ load_bytes(Dst, Base, Offset, {Signedness, Endianness}, X) when X > 1 -> hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(1)), hipe_rtl:mk_alu(Dst, Dst, sll, hipe_rtl:mk_imm(8)), hipe_rtl:mk_alu(Dst, Dst, 'or', Tmp1), - hipe_rtl:mk_branch(Offset, lt, Limit, hipe_rtl:label_name(LoopLbl), + hipe_rtl:mk_branch(Offset, ltu, Limit, hipe_rtl:label_name(LoopLbl), hipe_rtl:label_name(EndLbl)), EndLbl]; little -> @@ -1084,7 +1103,7 @@ load_bytes(Dst, Base, Offset, {Signedness, Endianness}, X) when X > 1 -> hipe_rtl:mk_load(Tmp1, Base, TmpOffset, byte, Signedness), hipe_rtl:mk_alu(Dst, Dst, sll, hipe_rtl:mk_imm(8)), hipe_rtl:mk_alu(Dst, Dst, 'or', Tmp1), - hipe_rtl:mk_branch(Offset, lt, TmpOffset, hipe_rtl:label_name(LoopLbl), + hipe_rtl:mk_branch(Offset, ltu, TmpOffset, hipe_rtl:label_name(LoopLbl), hipe_rtl:label_name(EndLbl)), EndLbl, hipe_rtl:mk_move(Offset, Limit)] @@ -1100,103 +1119,5 @@ create_gcsafe_regs(X) when X > 0 -> create_gcsafe_regs(0) -> []. -first_part(Var, Register, FalseLblName) -> - [EndLbl] = create_lbls(1), - EndName = hipe_rtl:label_name(EndLbl), - first_part(Var, Register, FalseLblName, EndName, EndName, [EndLbl]). - -first_part(Var, Register, FalseLblName, TrueLblName, BigLblName, Tail) -> - [FixnumLbl, NotFixnumLbl, BignumLbl, SuccessLbl] = create_lbls(4), - [hipe_tagscheme:test_fixnum(Var, hipe_rtl:label_name(FixnumLbl), - hipe_rtl:label_name(NotFixnumLbl), 0.99), - FixnumLbl, - hipe_tagscheme:fixnum_ge(Var, hipe_rtl:mk_imm(hipe_tagscheme:mk_fixnum(0)), - hipe_rtl:label_name(SuccessLbl), FalseLblName, - 0.99), - SuccessLbl, - hipe_tagscheme:untag_fixnum(Register, Var), - hipe_rtl:mk_goto(TrueLblName), - NotFixnumLbl, - %% Since binaries are not allowed to be larger than 2^wordsize bits - %% and since bignum digits are words, we know that a bignum with an - %% arity larger than one can't match. - hipe_tagscheme:test_pos_bignum_arity(Var, 1, hipe_rtl:label_name(BignumLbl), - FalseLblName, 0.99), - BignumLbl, - hipe_tagscheme:unsafe_get_one_word_pos_bignum(Register, Var), - hipe_rtl:mk_goto(BigLblName) | Tail]. - -make_size(1, BitsVar, FalseLblName) -> - [DstReg] = create_regs(1), - {first_part(BitsVar, DstReg, FalseLblName), DstReg}; -make_size(?BYTE_SIZE, BitsVar, FalseLblName) -> - [DstReg] = create_regs(1), - [FixnumLbl, BignumLbl] = create_lbls(2), - WordBits = hipe_rtl_arch:word_size() * ?BYTE_SIZE, - FixnumLblName = hipe_rtl:label_name(FixnumLbl), - Tail = [BignumLbl, - hipe_rtl:mk_branch(DstReg, 'ltu', - hipe_rtl:mk_imm(1 bsl (WordBits - ?BYTE_SHIFT)), - FixnumLblName, FalseLblName, 0.99), - FixnumLbl, - hipe_rtl:mk_alu(DstReg, DstReg, sll, hipe_rtl:mk_imm(?BYTE_SHIFT))], - Code = first_part(BitsVar, DstReg, FalseLblName, FixnumLblName, - hipe_rtl:label_name(BignumLbl), Tail), - {Code, DstReg}; -make_size(UnitImm, BitsVar, FalseLblName) -> - [DstReg] = create_regs(1), - UnitList = number2list(UnitImm), - Code = multiply_code(UnitList, BitsVar, DstReg, FalseLblName), - {Code, DstReg}. - -multiply_code(List=[Head|_Tail], Variable, Result, FalseLblName) -> - Test = set_high(Head), - Tmp1 = hipe_rtl:mk_new_reg(), - SuccessLbl = hipe_rtl:mk_new_label(), - Register = hipe_rtl:mk_new_reg(), - Code = [hipe_rtl:mk_move(Result, hipe_rtl:mk_imm(0))| - first_part(Variable, Register, FalseLblName)] - ++ - [hipe_rtl:mk_alub(Tmp1, Register, 'and', hipe_rtl:mk_imm(Test), - eq, hipe_rtl:label_name(SuccessLbl), - FalseLblName, 0.99), - SuccessLbl], - multiply_code(List, Register, Result, FalseLblName, Tmp1, Code). - -multiply_code([ShiftSize|Rest], Register, Result, FalseLblName, Tmp1, OldCode) -> - SuccessLbl = hipe_rtl:mk_new_label(), - Code = - OldCode ++ - [hipe_rtl:mk_alu(Tmp1, Register, sll, hipe_rtl:mk_imm(ShiftSize)), - hipe_rtl:mk_alub(Result, Tmp1, 'add', Result, not_overflow, - hipe_rtl:label_name(SuccessLbl), FalseLblName, 0.99), - SuccessLbl], - multiply_code(Rest, Register, Result, FalseLblName, Tmp1, Code); -multiply_code([], _Register, _Result, _FalseLblName, _Tmp1, Code) -> - Code. - -number2list(X) when is_integer(X), X >= 0 -> - number2list(X, []). - -number2list(1, Acc) -> - lists:reverse([0|Acc]); -number2list(0, Acc) -> - lists:reverse(Acc); -number2list(X, Acc) -> - F = floorlog2(X), - number2list(X-(1 bsl F), [F|Acc]). - -floorlog2(X) -> - round(math:log(X)/math:log(2)-0.5). - -set_high(X) -> - WordBits = hipe_rtl_arch:word_size() * ?BYTE_SIZE, - set_high(min(X, WordBits), WordBits, 0). - -set_high(0, _, Y) -> - Y; -set_high(X, WordBits, Y) -> - set_high(X-1, WordBits, Y+(1 bsl (WordBits-X))). - is_illegal_const(Const) -> Const >= 1 bsl (hipe_rtl_arch:word_size() * ?BYTE_SIZE) orelse Const < 0. diff --git a/lib/hipe/rtl/hipe_tagscheme.erl b/lib/hipe/rtl/hipe_tagscheme.erl index d77078acb6..8825a3ade3 100644 --- a/lib/hipe/rtl/hipe_tagscheme.erl +++ b/lib/hipe/rtl/hipe_tagscheme.erl @@ -42,7 +42,7 @@ test_ref/4, test_fun/4, test_fun2/5, test_matchstate/4, test_binary/4, test_bitstr/4, test_list/4, test_map/4, test_integer/4, test_number/4, test_tuple_N/5, - test_pos_bignum_arity/5]). + test_pos_bignum_arity/6]). -export([realtag_fixnum/2, tag_fixnum/2, realuntag_fixnum/2, untag_fixnum/2]). -export([test_two_fixnums/3, test_fixnums/4, unsafe_fixnum_add/3, unsafe_fixnum_sub/3, @@ -351,14 +351,23 @@ test_pos_bignum(X, TrueLab, FalseLab, Pred) -> mask_and_compare(Tmp, BigMask, ?TAG_HEADER_POS_BIG, TrueLab, FalseLab, Pred)]. -test_pos_bignum_arity(X, Arity, TrueLab, FalseLab, Pred) -> +test_pos_bignum_arity(X, Arity, TrueLab, NotPosBignumLab, FalseLab, Pred) -> Tmp = hipe_rtl:mk_new_reg_gcsafe(), - HalfTrueLab = hipe_rtl:mk_new_label(), + BoxedLab = hipe_rtl:mk_new_label(), HeaderImm = hipe_rtl:mk_imm(mk_header(Arity, ?TAG_HEADER_POS_BIG)), - [test_is_boxed(X, hipe_rtl:label_name(HalfTrueLab), FalseLab, Pred), - HalfTrueLab, - get_header(Tmp, X), - hipe_rtl:mk_branch(Tmp, 'eq', HeaderImm, TrueLab, FalseLab, Pred)]. + [test_is_boxed(X, hipe_rtl:label_name(BoxedLab), NotPosBignumLab, Pred), + BoxedLab, + get_header(Tmp, X)] ++ + case NotPosBignumLab =:= FalseLab of + true -> []; + false -> + BignumLab = hipe_rtl:mk_new_label(), + BigMask = ?TAG_HEADER_MASK, + [mask_and_compare(Tmp, BigMask, ?TAG_HEADER_POS_BIG, + hipe_rtl:label_name(BignumLab), NotPosBignumLab, Pred), + BignumLab] + end ++ + [hipe_rtl:mk_branch(Tmp, 'eq', HeaderImm, TrueLab, FalseLab, Pred)]. test_matchstate(X, TrueLab, FalseLab, Pred) -> Tmp = hipe_rtl:mk_new_reg_gcsafe(), diff --git a/lib/hipe/test/Makefile b/lib/hipe/test/Makefile index 009f503abb..09f4fd2129 100644 --- a/lib/hipe/test/Makefile +++ b/lib/hipe/test/Makefile @@ -10,8 +10,10 @@ MODULES= \ # .erl files for these modules are automatically generated GEN_MODULES= \ + basic_SUITE \ bs_SUITE \ - maps_SUITE + maps_SUITE \ + sanity_SUITE ERL_FILES= $(MODULES:%=%.erl) @@ -34,7 +36,7 @@ RELSYSDIR = $(RELEASE_PATH)/hipe_test # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +ERL_COMPILE_FLAGS += EBIN = . diff --git a/lib/hipe/test/basic_SUITE_data/basic_arith.erl b/lib/hipe/test/basic_SUITE_data/basic_arith.erl new file mode 100644 index 0000000000..28e99be053 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_arith.erl @@ -0,0 +1,72 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%--------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests cases for compilation of arithmetic. +%%%--------------------------------------------------------------------- +-module(basic_arith). + +-export([test/0]). + +test() -> + ok = test_rem(), + ok = test_bit_ops(), + ok = test_uplus(), + ok = test_bsl_errors(), + ok. + +%%---------------------------------------------------------------------- +%% Tests the remainder operator. + +test_rem() -> + 2 = ret_rem(42, 20), + -2 = ret_rem(-42, 20), + -2 = ret_rem(-42, -20), + {'EXIT', {badarith, _}} = ret_rem(3.14, 2), + {'EXIT', {badarith, _}} = ret_rem(42, 3.14), + ok. + +ret_rem(X, Y) -> + catch X rem Y. + +%%---------------------------------------------------------------------- +%% + +test_bit_ops() -> + 2 = bbb(11, 2, 16#3ff), + ok. + +bbb(X, Y, Z) -> + ((1 bsl X) bor Y) band Z. + +%%---------------------------------------------------------------------- +%% Tests unary plus: it used to be the identity function but not anymore + +test_uplus() -> + badarith = try uplus(gazonk) catch error:Err -> Err end, + 42 = uplus(42), + ok. + +uplus(X) -> +(X). + +%%---------------------------------------------------------------------- +%% The first part of this test triggered a bug in the emulator as one +%% of the arguments to bsl is not an integer. +%% +%% The second part triggered a compilation crash since an arithmetic +%% expression resulting in a 'system_limit' exception was statically +%% evaluated and an arithmetic result was expected. + +test_bsl_errors() -> + {'EXIT', {'badarith', _}} = (catch (t1(0, pad, 0))), + badarith = try t2(0, pad, 0) catch error:Err1 -> Err1 end, + system_limit = try (id(1) bsl 100000000) catch error:Err2 -> Err2 end, + ok. + +t1(_, X, _) -> + (1 bsl X) + 1. + +t2(_, X, _) -> + (X bsl 1) + 1. + +id(I) -> I. diff --git a/lib/hipe/test/basic_SUITE_data/basic_beam_instrs.erl b/lib/hipe/test/basic_SUITE_data/basic_beam_instrs.erl new file mode 100644 index 0000000000..6fafea3b09 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_beam_instrs.erl @@ -0,0 +1,102 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Tests for correct translation of various BEAM instructions. +%%%------------------------------------------------------------------- +-module(basic_beam_instrs). + +-export([test/0]). + +test() -> + ok = test_make_fun(), + ok = test_switch_val(), + ok = test_put_literal(), + ok = test_set_tuple_element(), + ok = test_unguarded_unsafe_element(), + ok. + +%%-------------------------------------------------------------------- +%% Tests whether the translation of make_fun works. + +test_make_fun() -> + {F, G} = double_the_fun(), + ok = F(), + {ok, 42} = G(42), + FV1 = {ok, free_var1}, + FV2 = {also, {free, var2}}, + {FV1, {ok, [bv]}, FV2} = contains_fun(FV1, ignored, FV2), + ok. + +double_the_fun() -> + {fun () -> ok end, fun (V) -> {ok, V} end}. + +contains_fun(X, _IGNORED_ARG, Y) -> + calls_fun(fun(Term) -> {X, Term, Y} end). + +calls_fun(F) -> + F({ok, [bv]}). + +%%-------------------------------------------------------------------- +%% Tests whether the translation of switch_val works. + +test_switch_val() -> + 'A' = sv(a), + 'B' = sv(b), + 'C' = sv(c), + foo = sv(d), + ok. + +sv(a) -> 'A'; +sv(b) -> 'B'; +sv(c) -> 'C'; +sv(_) -> foo. + +%%-------------------------------------------------------------------- +%% Tests correct handling of literals (statically constant terms) + +-define(QUADRUPLE, {a,b,c,42}). +-define(DEEP_LIST, [42,[42,[42]]]). + +test_put_literal() -> + ?QUADRUPLE = mk_literal_quadruple(), + ?DEEP_LIST = mk_literal_deep_list(), + ok. + +mk_literal_quadruple() -> + ?QUADRUPLE. + +mk_literal_deep_list() -> + ?DEEP_LIST. + +%%-------------------------------------------------------------------- +%% Tests whether the translation of set_tuple_element works. + +-record(rec, {f1, f2, f3, f4, f5}). + +test_set_tuple_element() -> + F2 = [a,b,c], F4 = {a,b}, + State0 = init_rec(F2, F4), + State1 = simple_set(State0, 42), + #rec{f1 = foo, f2 = F2, f3 = 42, f4 = F4, f5 = 42.0} = odd_set(State1, 21), + ok. + +init_rec(F2, F4) -> + #rec{f1 = bar, f2 = F2, f3 = 10, f4 = F4, f5 = 3.14}. + +simple_set(State, Val) -> %% f3 = Val is the one used in set_element; + State#rec{f3 = Val, f5 = Val*2}. %% this checks the case of variable + +odd_set(State, Val) -> %% f3 = foo is the one used in set_element; + State#rec{f1 = foo, f5 = Val*2.0}. %% this checks the case of constant + +%%-------------------------------------------------------------------- +%% Tests the handling of unguarded unsafe_element operations that BEAM +%% can sometimes construct on records (when it has enough context). + +test_unguarded_unsafe_element() -> + {badrecord, rec} = try unguarded_unsafe_element(42) catch error:E -> E end, + ok. + +unguarded_unsafe_element(X) -> + X#rec{f1 = X#rec.f3}. diff --git a/lib/hipe/test/basic_SUITE_data/basic_bifs.erl b/lib/hipe/test/basic_SUITE_data/basic_bifs.erl new file mode 100644 index 0000000000..e7ee2f3678 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_bifs.erl @@ -0,0 +1,257 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests for handling of BIFs in guards and body calls. +%%%------------------------------------------------------------------- +-module(basic_bifs). + +-export([test/0]). + +-define(BIG, 1398479237498374913984792374983749). + +test() -> + ok = test_abs(), + ok = test_binary_part(), + ok = test_element(), + ok = test_float(), + ok = test_float_to_list(), + ok = test_integer_to_list(), + ok = test_list_to_float(), + ok = test_list_to_integer(), + ok = test_round(), + ok = test_trunc(), + ok. + +%%-------------------------------------------------------------------- + +test_abs() -> + t_abs(5.5, 0.0, -100.0, 5, 0, -100, ?BIG). + +t_abs(F1, F2, F3, I1, I2, I3, BigNum) -> + %% Floats. + 5.5 = abs(F1), + 0.0 = abs(F2), + 100.0 = abs(F3), + %% Integers. + 5 = abs(I1), + 0 = abs(I2), + 100 = abs(I3), + %% Bignums. + BigNum = abs(BigNum), + BigNum = abs(-BigNum), + ok. + +%%-------------------------------------------------------------------- +%% Checks that 2-ary and 3-ary BIFs can be compiled to native code. + +test_binary_part() -> + Bin = <<1,2,3,4,5,6,7,8,9,10>>, + BinPart = bp3(Bin), + <<7,8>> = bp2(BinPart), + ok. + +bp2(Bin) -> + binary_part(Bin, {1, 2}). + +bp3(Bin) -> + binary_part(Bin, byte_size(Bin), -5). + +%%-------------------------------------------------------------------- + +test_element() -> + true = elem({a, b}), + false = elem({a, c}), + other = elem(gazonk), + ok. + +elem(T) when element(1, T) == a -> element(2, T) == b; +elem(_) -> other. + +%%-------------------------------------------------------------------- + +test_float() -> + t_float(0, 42, -100, 2.5, 0.0, -100.42, ?BIG, -?BIG). + +t_float(I1, I2, I3, F1, F2, F3, B1, B2) -> + 0.0 = float(I1), + 2.5 = float(F1), + 0.0 = float(F2), + -100.42 = float(F3), + 42.0 = float(I2), + -100.0 = float(I3), + %% Bignums. + 1398479237498374913984792374983749.0 = float(B1), + -1398479237498374913984792374983749.0 = float(B2), + %% Extremly big bignums. + Big = list_to_integer(duplicate(2000, $1)), + {'EXIT', _} = (catch float(Big)), + %% Invalid types and lists. + {'EXIT', _} = (catch my_list_to_integer(atom)), + {'EXIT', _} = (catch my_list_to_integer(123)), + {'EXIT', _} = (catch my_list_to_integer([$1, [$2]])), + {'EXIT', _} = (catch my_list_to_integer("1.2")), + {'EXIT', _} = (catch my_list_to_integer("a")), + {'EXIT', _} = (catch my_list_to_integer("")), + ok. + +my_list_to_integer(X) -> + list_to_integer(X). + +%%-------------------------------------------------------------------- + +test_float_to_list() -> + test_ftl("0.0e+0", 0.0), + test_ftl("2.5e+1", 25.0), + test_ftl("2.5e+0", 2.5), + test_ftl("2.5e-1", 0.25), + test_ftl("-3.5e+17", -350.0e15), + ok. + +test_ftl(Expect, Float) -> + %% No \n on the next line -- we want the line number from t_float_to_list. + Expect = remove_zeros(lists:reverse(float_to_list(Float)), []). + +%% Removes any non-significant zeros in a floating point number. +%% Example: 2.500000e+01 -> 2.5e+1 + +remove_zeros([$+, $e|Rest], [$0, X|Result]) -> + remove_zeros([$+, $e|Rest], [X|Result]); +remove_zeros([$-, $e|Rest], [$0, X|Result]) -> + remove_zeros([$-, $e|Rest], [X|Result]); +remove_zeros([$0, $.|Rest], [$e|Result]) -> + remove_zeros(Rest, [$., $0, $e|Result]); +remove_zeros([$0|Rest], [$e|Result]) -> + remove_zeros(Rest, [$e|Result]); +remove_zeros([Char|Rest], Result) -> + remove_zeros(Rest, [Char|Result]); +remove_zeros([], Result) -> + Result. + +%%-------------------------------------------------------------------- + +test_integer_to_list() -> + t_integer_to_list(0, 42, 32768, 268435455, 123456932798748738738). + +t_integer_to_list(I1, I2, I3, I4, BIG) -> + "0" = integer_to_list(I1), + "42" = integer_to_list(I2), + "-42" = integer_to_list(-I2), + "-42" = integer_to_list(-I2), + "32768" = integer_to_list(I3), + "268435455" = integer_to_list(I4), + "-268435455" = integer_to_list(-I4), + "123456932798748738738" = integer_to_list(BIG), + BigList = duplicate(2000, $1), + Big = list_to_integer(BigList), + BigList = integer_to_list(Big), + ok. + +%%-------------------------------------------------------------------- + +test_list_to_float() -> + ok = t_list_to_float_safe(), + ok = t_list_to_float_risky(). + +t_list_to_float_safe() -> + 0.0 = my_list_to_float("0.0"), + 0.0 = my_list_to_float("-0.0"), + 0.5 = my_list_to_float("0.5"), + -0.5 = my_list_to_float("-0.5"), + 100.0 = my_list_to_float("1.0e2"), + 127.5 = my_list_to_float("127.5"), + -199.5 = my_list_to_float("-199.5"), + {'EXIT', _} = (catch my_list_to_float("0")), + {'EXIT', _} = (catch my_list_to_float("0..0")), + {'EXIT', _} = (catch my_list_to_float("0e12")), + {'EXIT', _} = (catch my_list_to_float("--0.0")), + ok. + +my_list_to_float(X) -> + list_to_float(X). + +%% This might crash the emulator. (Used to crash Erlang 4.4.1 on Unix.) + +t_list_to_float_risky() -> + Many_Ones = duplicate(25000, $1), + ok = case list_to_float("2." ++ Many_Ones) of + F when is_float(F), 0.0 < F, F =< 3.14 -> ok + end, + {'EXIT', _} = (catch list_to_float("2" ++ Many_Ones)), + ok. + +%%-------------------------------------------------------------------- + +test_list_to_integer() -> + ok = t_list_to_integer_small("0", "00", "-0", "1", "-1", "42", "-12", + "32768", "268435455", "-268435455"), + ok = t_list_to_integer_bignum("123456932798748738738666"), + ok. + +t_list_to_integer_small(S1, S2, S3, S4, S5, S6, S7, S8, S9, S10) -> + 0 = list_to_integer(S1), + 0 = list_to_integer(S2), + 0 = list_to_integer(S3), + 1 = list_to_integer(S4), + -1 = list_to_integer(S5), + 42 = list_to_integer(S6), + -12 = list_to_integer(S7), + 32768 = list_to_integer(S8), + 268435455 = list_to_integer(S9), + -268435455 = list_to_integer(S10), + ok. + +t_list_to_integer_bignum(S) -> + 123456932798748738738666 = list_to_integer(S), + case list_to_integer(duplicate(2000, $1)) of + I when is_integer(I), I > 123456932798748738738666 -> ok + end. + +%%-------------------------------------------------------------------- + +test_round() -> + ok = t_round_small(0.0, 0.4, 0.5, -0.4, -0.5, 255.3, 255.6, -1033.3, -1033.6), + ok = t_round_big(4294967296.1, 4294967296.9), + ok. + +t_round_small(F1, F2, F3, F4, F5, F6, F7, F8, F9) -> + 0 = round(F1), + 0 = round(F2), + 1 = round(F3), + 0 = round(F4), + -1 = round(F5), + 255 = round(F6), + 256 = round(F7), + -1033 = round(F8), + -1034 = round(F9), + ok. + +t_round_big(B1, B2) -> + 4294967296 = round(B1), + 4294967297 = round(B2), + -4294967296 = round(-B1), + -4294967297 = round(-B2), + ok. + +%%-------------------------------------------------------------------- + +test_trunc() -> + t_trunc(0.0, 5.3333, -10.978987, 4294967305.7). + +t_trunc(F1, F2, F3, B) -> + 0 = trunc(F1), + 5 = trunc(F2), + -10 = trunc(F3), + %% Bignums. + 4294967305 = trunc(B), + -4294967305 = trunc(-B), + ok. + +%%-------------------------------------------------------------------- +%% Auxiliary functions below + +duplicate(N, X) when is_integer(N), N >= 0 -> + duplicate(N, X, []). + +duplicate(0, _, L) -> L; +duplicate(N, X, L) -> duplicate(N-1, X, [X|L]). diff --git a/lib/hipe/test/basic_SUITE_data/basic_bignums.erl b/lib/hipe/test/basic_SUITE_data/basic_bignums.erl new file mode 100644 index 0000000000..e3b523b3f5 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_bignums.erl @@ -0,0 +1,143 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains code examples that test bignum arithmetic and matching. +%%%------------------------------------------------------------------- +-module(basic_bignums). + +-export([test/0, test_bsl/0]). + +test() -> + ok = test_ops(), + ok = test_big_fac(), + ok = test_int_overfl_32(), + ok = test_int_overfl_64(), + ok = test_int_overfl_32_guard(), + ok = test_int_overfl_64_guard(), + ok. + +%%-------------------------------------------------------------------- +%% Define some constants for the tests of arithmetic operators + +-define(X, 68719476736). +-define(Y, 98765432101234). +-define(Z, 4722366482869645213696). +-define(W, 339254531512339254531512). + +-define(B1, 4398046511104). +-define(B5, 1645504557321206042154969182557350504982735865633579863348609024). +-define(B17, 86182066610968551542636378241108028056376767329454880514019834315878107616003372189510312530372009184902888961739623919010110377987011442493486117202360415845666384627768436296772219009176743399772868636439042064384). + +%%-------------------------------------------------------------------- + +test_ops() -> + ok = test_mult(), + ok = test_div(), + ok = test_round(), + ok = test_trunc(), + ok = test_bsl(), + ok. + +test_mult() -> + ?Z = mult(?X, ?X), + ok. + +mult(X, Y) -> X * Y. + +test_div() -> + 4 = div_f(339254531512, ?X), + 0 = div_f(?Y, ?Y+1), + 64 = div_f(?B1, ?X), + ?X = div_f(?Z, ?X), + 1073741824 = div_f(?Z, ?B1), + ok. + +div_f(X, Y) -> X div Y. + +test_round() -> + 0 = round_f(?Z, ?W), + 1 = round_f(?Y, ?Y), + 71 = round_f(?W, ?Z), + 1437 = round_f(?Y, ?X), + 47813960 = round_f(?Z, ?Y), + 4936803183406 = round_f(?W, ?X), + ok. + +trunc_f(X, Y) -> round(X/Y). + +test_trunc() -> + 0 = trunc_f(?Z, ?W), + 1 = trunc_f(?Y, ?Y), + 72 = trunc_f(?W, ?Z), + 1437 = trunc_f(?Y, ?X), + 47813961 = trunc_f(?Z, ?Y), + 4936803183407 = trunc_f(?W, ?X), + ok. + +round_f(X, Y) -> trunc(X/Y). + +test_bsl() -> + ?B1 = bsl_f(1, 42), + ?B5 = n(5, fun erlang:'bsl'/2, 1, 42), % use the operator + ?B17 = n(17, fun bsl_f/2, 1, 42), % use the local function + ok. + +bsl_f(X, Y) -> X bsl Y. + +%% applies a binary function N times +n(1, F, X, Y) -> F(X, Y); +n(N, F, X, Y) when N > 1 -> n(N-1, F, F(X, Y), Y). + +%%-------------------------------------------------------------------- + +-define(FAC42, 1405006117752879898543142606244511569936384000000000). + +test_big_fac() -> + ?FAC42 = fac(42), + ok. + +fac(0) -> 1; +fac(N) -> N * fac(N-1). + +%%-------------------------------------------------------------------- +%% Tests for correct handling of integer overflow + +test_int_overfl_32() -> + 16#7FFFFFF = add(16#7FFFFFF, 0), + 16#8000000 = add(16#8000000, 0), + 16#8000001 = add(16#8000000, 1), + case add(16#7FFFFFF, 1) of + 16#8000000 -> ok; + -16#7FFFFFF -> error + end. + +test_int_overfl_64() -> + 16#7FFFFFFFFFFFFFF = add(16#7FFFFFFFFFFFFFF, 0), + 16#800000000000000 = add(16#800000000000000, 0), + 16#800000000000001 = add(16#800000000000000, 1), + case add(16#7FFFFFFFFFFFFFF, 1) of + 16#800000000000000 -> ok; + -16#7FFFFFFFFFFFFFF -> error + end. + +add(X, Y) -> X + Y. + +%%-------------------------------------------------------------------- +%% Tests for correct handling of integer overflow in guards + +test_int_overfl_32_guard() -> + ok = overfl_in_guard(16#7ffffff, 0), + ok = overfl_in_guard(16#7ffffff, 16#7ffffff), + ok. + +test_int_overfl_64_guard() -> + ok = overfl_in_guard(16#7ffffffffffffff, 0), + ok = overfl_in_guard(16#7ffffffffffffff, 16#7ffffffffffffff), + ok. + +overfl_in_guard(X, Y) -> + case ok of + V when X+Y > 12 -> V; + _ -> bad + end. diff --git a/lib/hipe/test/basic_SUITE_data/basic_boolean.erl b/lib/hipe/test/basic_SUITE_data/basic_boolean.erl new file mode 100644 index 0000000000..e4a91ef5af --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_boolean.erl @@ -0,0 +1,47 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Tests for correct translation of booleans and their primitives. +%%%------------------------------------------------------------------- +-module(basic_boolean). + +-export([test/0]). + +test() -> + ok = test_boolean_ops(false, true), + ok = test_orelse_redundant(), + ok. + +%%-------------------------------------------------------------------- + +test_boolean_ops(F, T) -> + true = T and T, + false = T and F, + false = F and T, + false = F and F, + true = T or T, + true = T or F, + true = F or T, + false = F or F, + true = T andalso T, + false = T andalso F, + false = F andalso T, + false = F andalso F, + true = T orelse T, + true = T orelse F, + true = F orelse T, + false = F orelse F, + ok. + +%%-------------------------------------------------------------------- +%% Redundant test in BEAM code will generate type warning. + +test_orelse_redundant() -> + true = test_orelse(true, true, true), + ok. + +test_orelse(A, B, C) -> + A andalso B orelse C. + +%%-------------------------------------------------------------------- diff --git a/lib/hipe/test/basic_SUITE_data/basic_bugs_beam.erl b/lib/hipe/test/basic_SUITE_data/basic_bugs_beam.erl new file mode 100644 index 0000000000..964b0f423a --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_bugs_beam.erl @@ -0,0 +1,138 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains code examples that exhibited bugs in the BEAM compiler. +%%%------------------------------------------------------------------- +-module(basic_bugs_beam). + +-export([test/0]). + +%% the following is needed for the test_weird_message +-export([loop/1]). +%% the following are needed for the test_catch_bug +-behaviour(gen_server). +-export([start_link/1]). +-export([init/1, handle_call/3, handle_cast/2, handle_info/2, + terminate/2, code_change/3]). + +test() -> + ok = test_fp_basic_blocks(), + ok = test_weird_message(), + ok = test_catch_bug(), + ok. + +%%-------------------------------------------------------------------- +%% Test which shows that BEAM's splitting of basic blocks should take +%% into account that arithmetic operations implemented as BIFs can +%% also cause exceptions and thus calls to BIFs should end basic blocks. +%% +%% Investigated and fixed in the beginning of April 2004. +%%-------------------------------------------------------------------- + +test_fp_basic_blocks() -> + ok = t1(), + ok = t2(). + +t1() -> + X = (catch bad_arith1(2.0, 1.7)), + case X of + {'EXIT', {badarith, _}} -> + ok; + _ -> + error + end. + +bad_arith1(X, Y) when is_float(X) -> + X1 = X * 1.7e+308, + X2 = X1 + 1.0, + Y1 = Y * 2, + {X2, Y1}. + +%% Similarly, it is not kosher to have anything that can fail inside +%% the fp block since it will throw the exception before the fp +%% exception and we will get the same problems. + +t2() -> + case catch bad_arith2(2.0, []) of + {'EXIT', {badarith, _}} -> + ok; + _ -> + error + end. + +bad_arith2(X, Y) when is_float(X) -> + X1 = X * 1.7e+308, + Y1 = element(1, Y), + {X1 + 1.0, Y1}. + +%%-------------------------------------------------------------------- +%% Sending 'test' to this process should return 'ok'. But: +%% +%% 1> MOD:test(). +%% Weird: received true +%% timeout +%% +%% Surprisingly, the message has been bound to the value of 'ena' +%% in the record! The problem was visible in the .S file. +%%-------------------------------------------------------------------- + +-record(state, {ena = true}). + +test_weird_message() -> + P = spawn_link(?MODULE, loop, [#state{}]), + P ! {msg, self()}, + receive + What -> What + after 42 -> timeout + end. + +loop(S) -> + receive + _ when S#state.ena == false -> + io:format("Weird: ena is false\n"); + % loop(S); + {msg, Pid} -> + Pid ! ok; + % loop(S); + Other -> + io:format("Weird: received ~p\n", [Other]) + % loop(S) + end. + +%%-------------------------------------------------------------------- +%% This was posted on the Erlang mailing list as a question: +%% +%% Given the module below and the function call +%% "catch_bug:start_link(foo)." +%% from the Erlang shell, why does Erlang crash with "Catch not found"? +%% +%% The BEAM compiler was generating wrong code for this case; +%% this was fixed in R9C-0. Native code generation was OK. +%%-------------------------------------------------------------------- + +test_catch_bug() -> + ignore = start_link(foo), + ok. + +start_link(Param) -> + gen_server:start_link(?MODULE, Param, []). + +init(Param) -> + process_flag(trap_exit, true), + (catch begin + dummy(Param), + (catch exit(bar)) + end + ), + ignore. + +dummy(_) -> ok. + +%% gen_server callbacks below +handle_call(_Call, _From, State) -> {noreply, State}. +handle_cast(_Msg, State) -> {noreply, State}. +handle_info(_Msg, State) -> {noreply, State}. +terminate(_Reason, _State) -> ok. +code_change(_OldVsn, State, _Extra) -> {ok, State}. + diff --git a/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl b/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl new file mode 100644 index 0000000000..caa0e71d0b --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl @@ -0,0 +1,463 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%---------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains code examples that exhibited bugs in the HiPE compiler. +%%%---------------------------------------------------------------------- +-module(basic_bugs_hipe). + +-export([test/0]). + +test() -> + ok = test_ets_bifs(), + ok = test_szar_bug(), + ok = test_bit_shift(), + ok = test_match_big_list(), + ok = test_unsafe_bsl(), + ok = test_unsafe_bsr(), + ok = test_R12B5_seg_fault(), + ok = test_switch_neg_int(), + ok = test_icode_range_anal(), + ok. + +%%----------------------------------------------------------------------- +%% From: Bjorn Gustavsson +%% +%% This code, if HiPE compiled, crashed like this (on SPARC) +%% +%% (gdb) where +%% #0 fullsweep_heap (p=0x2c60dc, new_sz=610, objv=0xffbee8b4, nobj=3) +%% at beam/ggc.c:1060 +%% #1 0x7ff24 in erts_garbage_collect (p=0x2c60dc, need=2, objv=0x1128fc, ...) +%% at beam/ggc.c:1648 +%% #2 0xab6fc in hipe_mode_switch (p=0x2c60dc, cmd=704512, reg=0x1128fc) +%% at hipe/hipe_mode_switch.c:180 +%% #3 0x8e27c in process_main () at beam/beam_emu.c:3314 +%% #4 0x31338 in erl_start (argc=9, argv=0xffbeed5c) at beam/erl_init.c:936 +%% #5 0x2d9f4 in main (argc=9, argv=0xffbeed5c) at sys/unix/erl_main.c:28 +%% +%% A guess at what could be the problem: From R8, many ets BIFs trap +%% to other ets BIFs with a *different* arity (i.e. they have more or +%% less arguments). I have probably forgotten to mention that subtle +%% change. +%%----------------------------------------------------------------------- + +test_ets_bifs() -> + Seed = {1032, 15890, 22716}, + put(random_seed, Seed), + do_random_test(). + +do_random_test() -> + OrdSet = ets:new(xxx, [ordered_set]), + Set = ets:new(xxx, []), + do_n_times(fun() -> + Key = create_random_string(25), + Value = create_random_tuple(25), + ets:insert(OrdSet, {Key, Value}), + ets:insert(Set, {Key, Value}) + end, 5000), + %% io:format("~nData inserted~n"), + do_n_times(fun() -> + I = random:uniform(25), + Key = create_random_string(I) ++ '_', + L1 = ets_match_object(OrdSet, {Key, '_'}), + L2 = lists:sort(ets_match_object(Set, {Key, '_'})), + case L1 == L2 of + false -> + %% io:format("~p != ~p~n", [L1, L2]), + exit({not_eq, L1, L2}); + true -> + ok + end + end, 2000), + %% io:format("~nData matched~n"), + ets:match_delete(OrdSet, '_'), + ets:match_delete(Set, '_'), + ok. + +create_random_string(0) -> + []; +create_random_string(OfLength) -> + C = case random:uniform(2) of + 1 -> (random:uniform($Z - $A + 1) - 1) + $A; + _ -> (random:uniform($z - $a + 1) - 1) + $a + end, + [C | create_random_string(OfLength - 1)]. + +create_random_tuple(OfLength) -> + list_to_tuple([list_to_atom([X]) || X <- create_random_string(OfLength)]). + +ets_match_object(Tab,Expr) -> + case random:uniform(2) of + 1 -> ets:match_object(Tab,Expr); + _ -> match_object_chunked(Tab,Expr) + end. + +match_object_chunked(Tab,Expr) -> + match_object_chunked_collect(ets:match_object(Tab, Expr, + random:uniform(1999) + 1)). + +match_object_chunked_collect('$end_of_table') -> + []; +match_object_chunked_collect({Results, Continuation}) -> + Results ++ match_object_chunked_collect(ets:match_object(Continuation)). + +do_n_times(_, 0) -> + ok; +do_n_times(Fun, N) -> + Fun(), + case N rem 1000 of + 0 -> ok; %% WAS: io:format("."); + _ -> ok + end, + do_n_times(Fun, N - 1). + +%%----------------------------------------------------------------------- +%% From: Jozsef Berces (PR/ECZ) +%% Date: Feb 19, 2004 +%% +%% Program which was added to the testsuite as a result of another bug +%% report involving tuples as funs. Thanks God, these are no longer +%% supported, but the following is a good test for testing calling +%% native code funs from BEAM code (lists:map, lists:filter, ...). +%%----------------------------------------------------------------------- + +test_szar_bug() -> + ["A","B","C"] = smartconcat([], "H'A, H'B, H'C"), + ok. + +smartconcat(B, L) -> + LL = tokenize(L, $,), + NewlineDel = fun (X) -> killcontrol(X) end, + StripFun = fun (X) -> string:strip(X) end, + LL2 = lists:map(NewlineDel, lists:map(StripFun, LL)), + EmptyDel = fun(X) -> + case string:len(X) of + 0 -> false; + _ -> true + end + end, + LL3 = lists:filter(EmptyDel, LL2), + HexFormat = fun(X, Acc) -> + case string:str(X, "H'") of + 1 -> + case checkhex(string:substr(X, 3)) of + {ok, Y} -> + {Y, Acc}; + _ -> + {X, Acc + 1} + end; + _ -> + {X, Acc + 1} + end + end, + {LL4,_Ret} = lists:mapfoldl(HexFormat, 0, LL3), + lists:append(B, lists:sublist(LL4, lists:max([0, 25 - length(B)]))). + +checkhex(L) -> + checkhex(L, ""). + +checkhex([H | T], N) when H >= $0, H =< $9 -> + checkhex(T, [H | N]); +checkhex([H | T], N) when H >= $A, H =< $F -> + checkhex(T, [H | N]); +checkhex([H | T], N) when H =< 32 -> + checkhex(T, N); +checkhex([_ | _], _) -> + {error, ""}; +checkhex([], N) -> + {ok, lists:reverse(N)}. + +killcontrol([C | S]) when C < 32 -> + killcontrol(S); +killcontrol([C | S]) -> + [C | killcontrol(S)]; +killcontrol([]) -> + []. + +tokenize(L, C) -> + tokenize(L, C, [], []). + +tokenize([C | T], C, A, B) -> + case A of + [] -> + tokenize(T, C, [], B); + _ -> + tokenize(T, C, [], [lists:reverse(A) | B]) + end; +tokenize([H | T], C, A, B) -> + tokenize(T, C, [H | A], B); +tokenize(_, _, [], B) -> + lists:reverse(B); +tokenize(_, _, A, B) -> + lists:reverse([lists:reverse(A) | B]). + +%%----------------------------------------------------------------------- +%% From: Niclas Pehrsson +%% Date: Apr 20, 2006 +%% +%% We found something weird with the bit shifting in HiPE. It seems +%% that bsr in some cases shifts the bits in the wrong way... +%% +%% Fixed about 10 mins afterwards; was a bug in constant propagation. +%%----------------------------------------------------------------------- + +test_bit_shift() -> + 1 = plain_shift(), % 1 + 6 = length_list_plus(), % 6 + 0 = shift_length_list(), % 0 + 1 = shift_length_list_plus(), % 1 + 1 = shift_length_list_plus2(), % 1 + 24 = shift_length_list_plus_bsl(), % 24 + 1 = shift_fun(), % 1 + %% {1, 6, 0, 1, 1, 24, 1} = {A, B, C, D, E, F, G}, + ok. + +plain_shift() -> + 6 bsr 2. + +length_list() -> + length([0,0]). + +length_list_plus() -> + length([0,0]) + 4. + +shift_length_list() -> + length([0,0]) bsr 2. + +shift_length_list_plus() -> + (length([0,0]) + 4) bsr 2. + +shift_length_list_plus_bsl() -> + (length([0,0]) + 4) bsl 2. + +shift_length_list_plus2() -> + N = length([0,0]) + 4, + N bsr 2. + +shift_fun() -> + (length_list() + 4) bsr 2. + +%%----------------------------------------------------------------------- +%% From: Igor Goryachev +%% Date: June 15, 2006 +%% +%% I have experienced a different behaviour and possibly a weird result +%% while playing with matching a big list on x86 and x86_64 machines. +%%----------------------------------------------------------------------- + +-define(BIG_LIST, + ["uid", "nickname", "n_family", "n_given", "email_pref", + "tel_home_number", "tel_cellular_number", "adr_home_country", + "adr_home_locality", "adr_home_region", "url", "gender", "bday", + "constitution", "height", "weight", "hair", "routine", "smoke", + "maritalstatus", "children", "independence", "school_number", + "school_locality", "school_title", "school_period", "org_orgname", + "title", "adr_work_locality", "photo_type", "photo_binval"]). + +test_match_big_list() -> + case create_tuple_with_big_const_list() of + {selected, ?BIG_LIST, _} -> ok; + _ -> weird + end. + +create_tuple_with_big_const_list() -> + {selected, ?BIG_LIST, [{"test"}]}. + +%%----------------------------------------------------------------------- +%% In October 2006 the HiPE compiler acquired more type-driven +%% optimisations of arithmetic operations. One of these, the +%% transformation of bsl to a pure fixnum bsl fixnum -> fixnum version +%% (unsafe_bsl), was incorrectly performed even when the result +%% wouldn't be a fixnum. The error occurred for all backends, but the +%% only place known to break was hipe_arm:imm_to_am1/2. Some +%% immediates got broken on ARM, causing segmentation faults in +%% compiler_tests when HiPE recompiled itself. +%%----------------------------------------------------------------------- + +test_unsafe_bsl() -> + ok = bsl_check(bsl_test_cases()). + +bsl_test_cases() -> + [{16#FF, {16#FF, 0}}, + {16#F000000F, {16#FF, 2}}]. + +bsl_check([]) -> ok; +bsl_check([{X, Y}|Rest]) -> + case imm_to_am1(X) of + Y -> bsl_check(Rest); + _ -> 'hipe_broke_bsl' + end. + +imm_to_am1(Imm) -> + imm_to_am1(Imm band 16#FFFFFFFF, 16). +imm_to_am1(Imm, RotCnt) -> + if Imm >= 0, Imm =< 255 -> {Imm, RotCnt band 15}; + true -> + NewRotCnt = RotCnt - 1, + if NewRotCnt =:= 0 -> []; % full circle, no joy + true -> + NewImm = (Imm bsr 2) bor ((Imm band 3) bsl 30), + imm_to_am1(NewImm, NewRotCnt) + end + end. + +%%----------------------------------------------------------------------- +%% Another transformation, namely that of bsr to a pure fixnum bsr +%% fixnum -> fixnum version (unsafe_bsr), failed to check for shifts +%% larger than the number of bits in fixnums. Such shifts should +%% return zero, but instead they became plain machine-level shift +%% instructions. Machines often only consider the low-order bits of +%% the shift count, so machine-level shifts larger than the word size +%% do not match the Erlang semantics. +%%----------------------------------------------------------------------- + +test_unsafe_bsr() -> + ok = bsr_check(bsr_test_cases()). + +bsr_test_cases() -> + [{16#FF, 4, 16#0F}, + {16#FF, 64, 0}]. + +bsr_check([]) -> ok; +bsr_check([{X, Y, Z}|Rest]) -> + case do_bsr(X, Y) of + Z -> bsr_check(Rest); + _ -> 'hipe_broke_bsr' + end. + +do_bsr(X, Y) -> + (X band 16#FFFF) bsr (Y band 16#FFFF). + +%%----------------------------------------------------------------------- +%% From: Sergey S, mid January 2009. +%% +%% While I was playing with +native option, I run into a bug in HiPE +%% which leads to segmentation fault using +native and Erlang R12B-5. +%% +%% Eshell V5.6.5 +%% 1> crash:test(). +%% # Some message to be printed here each loop iteration +%% Segmentation fault +%% +%% Diagnosed and fixed by Mikael Pettersson (22 Jan 2009): +%% +%% I've analysed the recently posted HiPE bug report on erlang-bugs +%% <http://www.erlang.org/pipermail/erlang-bugs/2009-January/001162.html>. +%% The segfault is caused by memory corruption, which in turn is caused +%% by RTL removing an update of the HP (heap pointer) register due to +%% what looks like broken liveness information. +%%----------------------------------------------------------------------- + +test_R12B5_seg_fault() -> + _ = spawn(fun() -> init() end), + ok. + +init() -> + repeat(5, fun() -> void end), + receive after infinity -> ok end. + +repeat(0, _) -> + ok; +repeat(N, Fun) -> + %% io:format("# Some message to be printed here each loop iteration\n"), + Fun(), + repeat(N - 1, Fun). + +%%----------------------------------------------------------------------- +%% From: Jon Meredith +%% Date: July 9, 2009 +%% +%% Binary search key tables are sorted by the loader based on the +%% runtime representations of the keys as unsigned words. However, +%% the code generated for the binary search used signed comparisons. +%% That worked for atoms and non-negative fixnums, but not for +%% negative fixnums. Fixed by Mikael Pettersson July 10, 2009. +%%----------------------------------------------------------------------- + +test_switch_neg_int() -> + ok = f(-80, 8). + +f(10, -1) -> ok; +f(X, Y) -> + Y = g(X), + f(X + 10, Y - 1). + +g(X) -> % g(0) should be 0 but became -1 + case X of + 0 -> 0; + -10 -> 1; + -20 -> 2; + -30 -> 3; + -40 -> 4; + -50 -> 5; + -60 -> 6; + -70 -> 7; + -80 -> 8; + _ -> -1 + end. + +%%----------------------------------------------------------------------- +%% From: Paul Guyot +%% Date: Jan 31, 2011 +%% +%% There is a bug in HiPE compilation with the comparison of floats +%% with integers. This bug happens in functions f/1 and g/2 below. +%% BEAM will evaluate f_eq(42) and f_eq(42.0) to true, while HiPE +%% will evaluate them to false. +%% +%% The culprit was the Icode range analysis which was buggy. (On the +%% other hand, HiPE properly evaluated these calls to true if passed +%% the option 'no_icode_range'.) Fixed by Kostis Sagonas. +%% -------------------------------------------------------------------- + +test_icode_range_anal() -> + true = f_eq(42), + true = f_eq(42.0), + false = f_ne(42), + false = f_ne(42.0), + false = f_eq_ex(42), + false = f_eq_ex(42.0), + true = f_ne_ex(42), + true = f_ne_ex(42.0), + false = f_gt(42), + false = f_gt(42.0), + true = f_le(42), + true = f_le(42.0), + zero_test = g(0, test), + zero_test = g(0.0, test), + non_zero_test = g(42, test), + other = g(42, other), + ok. + +f_eq(X) -> + Y = X / 2, + Y == 21. + +f_ne(X) -> + Y = X / 2, + Y /= 21. + +f_eq_ex(X) -> + Y = X / 2, + Y =:= 21. + +f_ne_ex(X) -> + Y = X / 2, + Y =/= 21. + +f_gt(X) -> + Y = X / 2, + Y > 21. + +f_le(X) -> + Y = X / 2, + Y =< 21. + +g(X, Z) -> + Y = X / 2, + case Z of + test when Y == 0 -> zero_test; + test -> non_zero_test; + other -> other + end. diff --git a/lib/hipe/test/basic_SUITE_data/basic_comparisons.erl b/lib/hipe/test/basic_SUITE_data/basic_comparisons.erl new file mode 100644 index 0000000000..8dab2cab1f --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_comparisons.erl @@ -0,0 +1,157 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests for correct execution of comparison operators. +%%%------------------------------------------------------------------- +-module(basic_comparisons). + +-export([test/0]). + +test() -> + Ns = [0, 0.0, 42, 42.0, gazonk], + T1F4 = [true, false, false, false, false], + T2F3 = [true, true, false, false, false], + F1T4 = [false, true, true, true, true], + F2T3 = [false, false, true, true, true], + %% tests for calls + T1F4 = [eq_exact_call(0, N) || N <- Ns], + F1T4 = [ne_exact_call(0, N) || N <- Ns], + T2F3 = [eq_call(0, N) || N <- Ns], + F2T3 = [ne_call(0, N) || N <- Ns], + %% tests for guards + T1F4 = [eq_exact_guard(0, N) || N <- Ns], + F1T4 = [ne_exact_guard(0, N) || N <- Ns], + T2F3 = [eq_guard(0, N) || N <- Ns], + F2T3 = [ne_guard(0, N) || N <- Ns], + %% some more tests + ok = test_against_zero(), + ok = test_against_other_terms(), + ok = test_sofs_func(), + ok. + +test_against_zero() -> + Xs = [0, 1, 0.0], + [true, false, false] = [is_zero_int(X) || X <- Xs], + [true, false, true] = [is_zero_num(X) || X <- Xs], + [false, true, true] = [is_nonzero_int(X) || X <- Xs], + [false, true, false] = [is_nonzero_num(X) || X <- Xs], + ok. + +test_against_other_terms() -> + TTT = {true, true, true}, + FFF = {false, false, false}, + TTT = {is_foo_exact(foo), is_foo_term1(foo), is_foo_term2(foo)}, + FFF = {is_foo_exact(bar), is_foo_term1(bar), is_foo_term2(bar)}, + FFF = {is_nonfoo_exact(foo), is_nonfoo_term1(foo), is_nonfoo_term2(foo)}, + TTT = {is_nonfoo_exact(bar), is_nonfoo_term1(bar), is_nonfoo_term2(bar)}, + Tup = {a, {42}, [c]}, + TTT = {is_tuple_skel(Tup), is_tuple_exact(Tup), is_tuple_term(Tup)}, + BNi = <<42>>, + TTT = {is_bin_exact(BNi), is_bin_term1(BNi), is_bin_term2(BNi)}, + BNf = <<42/float>>, + FFF = {is_bin_exact(BNf), is_bin_term1(BNf), is_bin_term2(BNf)}, + ok. + +test_sofs_func() -> + L = [0, 0.0], + ok = sofs_func(L, L, L). + +%%-------------------------------------------------------------------- +%% Test for comparison operators used in body calls + +eq_exact_call(X, Y) -> X =:= Y. + +ne_exact_call(X, Y) -> X =/= Y. + +eq_call(X, Y) -> X == Y. + +ne_call(X, Y) -> X /= Y. + +%%-------------------------------------------------------------------- +%% Tests for comparison operators used as guards + +eq_exact_guard(X, Y) when X =:= Y -> true; +eq_exact_guard(_, _) -> false. + +ne_exact_guard(X, Y) when X =/= Y -> true; +ne_exact_guard(_, _) -> false. + +eq_guard(X, Y) when X == Y -> true; +eq_guard(_, _) -> false. + +ne_guard(X, Y) when X /= Y -> true; +ne_guard(_, _) -> false. + +%%-------------------------------------------------------------------- + +is_zero_int(N) when N =:= 0 -> true; +is_zero_int(_) -> false. + +is_nonzero_int(N) when N =/= 0 -> true; +is_nonzero_int(_) -> false. + +is_zero_num(N) when N == 0 -> true; +is_zero_num(_) -> false. + +is_nonzero_num(N) when N /= 0 -> true; +is_nonzero_num(_) -> false. + +%%-------------------------------------------------------------------- +%% There should not really be any difference in the generated code +%% for the following three functions. + +is_foo_exact(A) when A =:= foo -> true; +is_foo_exact(_) -> false. + +is_foo_term1(A) when A == foo -> true; +is_foo_term1(_) -> false. + +is_foo_term2(A) when foo == A -> true; +is_foo_term2(_) -> false. + +%%-------------------------------------------------------------------- +%% Same for these cases + +is_nonfoo_exact(A) when A =/= foo -> true; +is_nonfoo_exact(_) -> false. + +is_nonfoo_term1(A) when A /= foo -> true; +is_nonfoo_term1(_) -> false. + +is_nonfoo_term2(A) when foo /= A -> true; +is_nonfoo_term2(_) -> false. + +%%-------------------------------------------------------------------- + +is_tuple_skel({A,{B},[C]}) when is_atom(A), is_integer(B), is_atom(C) -> true; +is_tuple_skel(T) when is_tuple(T) -> false. + +is_tuple_exact(T) when T =:= {a,{42},[c]} -> true; +is_tuple_exact(T) when is_tuple(T) -> false. + +is_tuple_term(T) when T == {a,{42.0},[c]} -> true; +is_tuple_term(T) when is_tuple(T) -> false. + +%%-------------------------------------------------------------------- +%% But for binaries the treatment has to be different, due to the need +%% for construction of the binary in the guard. + +is_bin_exact(B) when B =:= <<42>> -> true; +is_bin_exact(_) -> false. + +is_bin_term1(B) when B == <<42>> -> true; +is_bin_term1(_) -> false. + +is_bin_term2(B) when <<42>> == B -> true; +is_bin_term2(_) -> false. + +%%-------------------------------------------------------------------- +%% a test from sofs.erl which failed at some point + +sofs_func([X | Ts], X0, L) when X /= X0 -> + sofs_func(Ts, X, L); +sofs_func([X | _Ts], X0, _L) when X == X0 -> + ok; +sofs_func([], _X0, L) -> + L. diff --git a/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl b/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl new file mode 100644 index 0000000000..229a0516dc --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl @@ -0,0 +1,465 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests that raise exceptions and catch them. +%%%------------------------------------------------------------------- +-module(basic_exceptions). + +-export([test/0, test_catches/0]). + +%% functions used as arguments to spawn/3 +-export([bad_guy/2]). + +test() -> + ok = test_catch_exit(42), + ok = test_catch_throw(42), + ok = test_catch_element(), + ok = test_catch_crash(), + ok = test_catch_empty(), + ok = test_catch_merge(), + ok = test_catches_merged(), + ok = test_pending_errors(), + ok = test_bad_fun_call(), + ok = test_guard_bif(), + ok. + +%%-------------------------------------------------------------------- +%% Written in 2001 by Erik Johansson. + +test_catches() -> + ExitBar = {'EXIT', bar}, + L1 = [ExitBar, ok, ExitBar, {ok, ExitBar}], + L1 = [t1(), t2(), t3(), t4()], + badarith = (catch element(1, element(2, t5(a, b)))), + L2 = [42, ExitBar, ExitBar, {no_exception, ok}], + L2 = [t5(21, 21), t6(), t7(), t8()], + ok. + +t1() -> + catch foo(). + +t2() -> + V = (catch ok()), + s(), + V. + +t3() -> + V = (catch foo()), + V. + +t4() -> + V1 = ok(), + V2 = (catch foo()), + {V1, V2}. + +t5(A, B) -> + catch A + B. + +t6() -> + catch {no_exception, ok(), foo()}. + +t7() -> + catch {no_exception, foo(), ok()}. + +t8() -> + catch {no_exception, ok()}. + +foo() -> + s(), + exit(bar). + +ok() -> s(), ok. + +s() -> nada. + +%%-------------------------------------------------------------------- + +test_catch_exit(N) -> + {'EXIT', N} = (catch exit(N)), + {'EXIT', 42} = (catch exit(42)), + 42 = try exit(N) catch exit:R1 -> R1 end, + 42 = try exit(42) catch exit:R2 -> R2 end, + ok. + +%%-------------------------------------------------------------------- + +test_catch_throw(N) -> + N = (catch throw(N)), + 42 = (catch throw(42)), + 42 = try throw(N) catch throw:R1 -> R1 end, + 42 = try throw(42) catch throw:R2 -> R2 end, + ok. + +%%-------------------------------------------------------------------- + +test_catch_element() -> + 'EXIT' = test_catch_element([]), + 'EXIT' = test_catch_element(42), + ok. + +test_catch_element(N) -> + element(1, catch element(N, {1,2,3,4,5,6,7,8,9,10,11})). + +%%-------------------------------------------------------------------- + +-define(try_match(E), + catch ?MODULE:non_existing(), + {'EXIT', {{badmatch, nomatch}, _}} = (catch E = no_match())). + +test_catch_crash() -> + ?try_match(a), + ?try_match(42), + ?try_match({a, b, c}), + ?try_match([]), + ?try_match(1.0), + ok. + +no_match() -> nomatch. + +%% small_test() -> +%% catch ?MODULE:non_existing(), +%% io:format("Before\n",[]), +%% hipe_bifs:show_nstack(self()), +%% io:format("After\n",[]), +%% garbage_collect(). + +%%-------------------------------------------------------------------- +%% Tests whether the HiPE compiler optimizes catches in a way that +%% does not result in an infinite loop. +%%-------------------------------------------------------------------- + +test_catch_empty() -> + badmatch(). + +badmatch() -> + Big = ret_big(), + Float = ret_float(), + catch a = Big, + catch b = Float, + ok = case Big of Big -> ok end, + ok = case Float of Float -> ok end, + ok. + +ret_big() -> + 329847987298478924982978248748729829487298292982972978239874. + +ret_float() -> + 3.1415927. + +%%-------------------------------------------------------------------- +%% Test that shows how BEAM can merge catch-end blocks that belong to +%% different catch-start instructions. Written by Richard Carlsson. +%%-------------------------------------------------------------------- + +test_catch_merge() -> + merge(get(whatever)). + +merge(foo=X) -> + catch f(X), + catch g(X); +merge(X) -> + catch f(X), + catch g(X). + +f(_) -> ok. + +g(_) -> ok. + +%%-------------------------------------------------------------------- +%% Written by Tobias Lindahl. + +test_catches_merged() -> + {'EXIT', _} = merged_catches(foo), + {'EXIT', {badarith, _}} = merged_catches(bar), + {'EXIT', _} = merged_catches(baz), + ok. + +merged_catches(X) -> + case X of + foo -> catch fail1(0); + bar -> catch {catch(1 = X), fail2(0)}; + baz -> catch fail3(0) + end. + +fail1(X) -> 1/X. + +fail2(X) -> 1/X. + +fail3(X) -> 1/X. + +%%-------------------------------------------------------------------- +%% Taken from exception_SUITE.erl +%%-------------------------------------------------------------------- + +test_pending_errors() -> + error_logger:tty(false), % disable printouts of error reports + pending_errors(). + +%% Test various exceptions, in the presence of a previous error +%% suppressed in a guard. +pending_errors() -> + pending(e_badmatch, {badmatch, b}), + pending(x, function_clause), + pending(e_case, {case_clause, xxx}), + pending(e_if, if_clause), + %% pending(e_badarith, badarith), + %% pending(e_undef, undef), + pending(e_timeoutval, timeout_value), + %% pending(e_badarg, badarg), + %% pending(e_badarg_spawn, badarg), + ok. + +bad_guy(pe_badarith, Other) when Other+1 =:= 0 -> % badarith (suppressed) + ok; +bad_guy(pe_badarg, Other) when length(Other) > 0 -> % badarg (suppressed) + ok; +bad_guy(_, e_case) -> + case xxx() of + ok -> ok + end; % case_clause +bad_guy(_, e_if) -> + B = b(), + if + a == B -> ok + end; % if_clause +%% bad_guy(_, e_badarith) -> +%% 1+b; % badarith +bad_guy(_, e_undef) -> + non_existing_module:foo(); % undef +bad_guy(_, e_timeoutval) -> + receive + after gazonk -> ok % timeout_value + end; +bad_guy(_, e_badarg) -> + node(xxx); % badarg +bad_guy(_, e_badarg_spawn) -> + spawn({}, {}, {}); % badarg +bad_guy(_, e_badmatch) -> + a = b(). % badmatch + +xxx() -> xxx. + +b() -> b. + +pending(Arg, Expected) -> + pending(pe_badarith, Arg, Expected), + pending(pe_badarg, Arg, Expected). + +pending(First, Second, Expected) -> + pending_catched(First, Second, Expected), + pending_exit_message([First, Second], Expected). + +pending_catched(First, Second, Expected) -> + %% ok = io:format("Catching bad_guy(~p, ~p)\n", [First, Second]), + case catch bad_guy(First, Second) of + {'EXIT', Reason} -> + pending(Reason, bad_guy, [First, Second], Expected); + Other -> + exit({not_exit, Other}) + end. + +pending_exit_message(Args, Expected) -> + %% ok = io:format("Trapping exits from spawn_link(~p, ~p, ~p)\n", + %% [?MODULE, bad_guy, Args]), + process_flag(trap_exit, true), + Pid = spawn_link(?MODULE, bad_guy, Args), + receive + {'EXIT', Pid, Reason} -> + pending(Reason, bad_guy, Args, Expected); + Other -> + exit({unexpected_message, Other}) + after 10000 -> + exit(timeout) + end, + process_flag(trap_exit, false). + +%% pending({badarg, [{erlang,Bif,BifArgs},{?MODULE,Func,Arity}|_]}, +%% Func, Args, _Code) +%% when atom(Bif), list(BifArgs), length(Args) =:= Arity -> +%% ok; +pending({badarg,Trace}, _, _, _) when is_list(Trace) -> + ok; +%% pending({undef,[{non_existing_module,foo,[]}|_]}, _, _, _) -> +%% ok; +pending({undef,Trace}, _, _, _) when is_list(Trace) -> + ok; +%% pending({function_clause,[{?MODULE,Func,Args}|_]}, Func, Args, _Code) -> +%% ok; +pending({function_clause,Trace}, _, _, _) when is_list(Trace) -> + ok; +%% pending({Code,[{?MODULE,Func,Arity}|_]}, Func, Args, Code) +%% when length(Args) =:= Arity -> +%% ok; +pending({Code,Trace}, _, _, Code) when is_list(Trace) -> + ok; +pending(Reason, _Function, _Args, _Code) -> + exit({bad_exit_reason, Reason}). + +%%-------------------------------------------------------------------- +%% Taken from fun_SUITE.erl +%% +%% Checks correct exception throwing when calling a bad fun. +%%-------------------------------------------------------------------- + +test_bad_fun_call() -> + ok = bad_call_fc(42), + ok = bad_call_fc(xx), + ok = bad_call_fc({}), + ok = bad_call_fc({1}), + ok = bad_call_fc({1,2,3}), + ok = bad_call_fc({1,2,3}), + ok = bad_call_fc({1,2,3,4}), + ok = bad_call_fc({1,2,3,4,5,6}), + ok = bad_call_fc({1,2,3,4,5}), + ok = bad_call_fc({1,2}), + ok. + +bad_call_fc(Fun) -> + Args = [some, stupid, args], + Res = (catch Fun(Fun(Args))), + case Res of + {'EXIT', {{badfun, Fun} ,_Where}} -> + ok; %% = io:format("~p(~p) -> ~p\n", [Fun, Args, Res]); + Other -> + io:format("~p(~p) -> ~p\n", [Fun, Args, Res]), + exit({bad_result, Other}) + end. + +%%-------------------------------------------------------------------- +%% Taken from guard_SUITE.erl +%% +%% Tests correct handling of exceptions by calling guard BIFs with +%% nasty (but legal arguments). +%%-------------------------------------------------------------------- + +test_guard_bif() -> + Big = -237849247829874297658726487367328971246284736473821617265433, + Float = 387924.874, + + %% Succeding use of guard bifs. + + try_gbif('abs/1', Big, -Big), + try_gbif('float/1', Big, float(Big)), + try_gbif('trunc/1', Float, 387924.0), + try_gbif('round/1', Float, 387925.0), + try_gbif('length/1', [], 0), + + try_gbif('length/1', [a], 1), + try_gbif('length/1', [a, b], 2), + try_gbif('length/1', lists:seq(0, 31), 32), + + try_gbif('hd/1', [a], a), + try_gbif('hd/1', [a, b], a), + + try_gbif('tl/1', [a], []), + try_gbif('tl/1', [a, b], [b]), + try_gbif('tl/1', [a, b, c], [b, c]), + + try_gbif('size/1', {}, 0), + try_gbif('size/1', {a}, 1), + try_gbif('size/1', {a, b}, 2), + try_gbif('size/1', {a, b, c}, 3), + try_gbif('size/1', list_to_binary([]), 0), + try_gbif('size/1', list_to_binary([1]), 1), + try_gbif('size/1', list_to_binary([1, 2]), 2), + try_gbif('size/1', list_to_binary([1, 2, 3]), 3), + + try_gbif('element/2', {x}, {1, x}), + try_gbif('element/2', {x, y}, {1, x}), + try_gbif('element/2', {x, y}, {2, y}), + + try_gbif('self/0', 0, self()), + try_gbif('node/0', 0, node()), + try_gbif('node/1', self(), node()), + + %% Failing use of guard bifs. + + try_fail_gbif('abs/1', Big, 1), + try_fail_gbif('abs/1', [], 1), + + try_fail_gbif('float/1', Big, 42), + try_fail_gbif('float/1', [], 42), + + try_fail_gbif('trunc/1', Float, 0.0), + try_fail_gbif('trunc/1', [], 0.0), + + try_fail_gbif('round/1', Float, 1.0), + try_fail_gbif('round/1', [], a), + + try_fail_gbif('length/1', [], 1), + try_fail_gbif('length/1', [a], 0), + try_fail_gbif('length/1', a, 0), + try_fail_gbif('length/1', {a}, 0), + + try_fail_gbif('hd/1', [], 0), + try_fail_gbif('hd/1', [a], x), + try_fail_gbif('hd/1', x, x), + + try_fail_gbif('tl/1', [], 0), + try_fail_gbif('tl/1', [a], x), + try_fail_gbif('tl/1', x, x), + + try_fail_gbif('size/1', {}, 1), + try_fail_gbif('size/1', [], 0), + try_fail_gbif('size/1', [a], 1), + try_fail_gbif('size/1', fun() -> 1 end, 0), + try_fail_gbif('size/1', fun() -> 1 end, 1), + + try_fail_gbif('element/2', {}, {1, x}), + try_fail_gbif('element/2', {x}, {1, y}), + try_fail_gbif('element/2', [], {1, z}), + + try_fail_gbif('self/0', 0, list_to_pid("<0.0.0>")), + try_fail_gbif('node/0', 0, xxxx), + try_fail_gbif('node/1', self(), xxx), + try_fail_gbif('node/1', yyy, xxx), + ok. + +try_gbif(Id, X, Y) -> + case guard_bif(Id, X, Y) of + {Id, X, Y} -> + %% io:format("guard_bif(~p, ~p, ~p) -- ok\n", [Id, X, Y]); + ok; + Other -> + ok = io:format("guard_bif(~p, ~p, ~p) -- bad result: ~p\n", + [Id, X, Y, Other]), + exit({bad_result,try_gbif}) + end. + +try_fail_gbif(Id, X, Y) -> + case catch guard_bif(Id, X, Y) of + %% {'EXIT', {function_clause,[{?MODULE,guard_bif,[Id,X,Y]}|_]}} -> + {'EXIT', {function_clause,_}} -> % in HiPE, a trace is not generated + %% io:format("guard_bif(~p, ~p, ~p) -- ok\n", [Id,X,Y]); + ok; + Other -> + ok = io:format("guard_bif(~p, ~p, ~p) -- bad result: ~p\n", + [Id, X, Y, Other]), + exit({bad_result,try_fail_gbif}) + end. + +guard_bif('abs/1', X, Y) when abs(X) == Y -> + {'abs/1', X, Y}; +guard_bif('float/1', X, Y) when float(X) == Y -> + {'float/1', X, Y}; +guard_bif('trunc/1', X, Y) when trunc(X) == Y -> + {'trunc/1', X, Y}; +guard_bif('round/1', X, Y) when round(X) == Y -> + {'round/1', X, Y}; +guard_bif('length/1', X, Y) when length(X) == Y -> + {'length/1', X, Y}; +guard_bif('hd/1', X, Y) when hd(X) == Y -> + {'hd/1', X, Y}; +guard_bif('tl/1', X, Y) when tl(X) == Y -> + {'tl/1', X, Y}; +guard_bif('size/1', X, Y) when size(X) == Y -> + {'size/1', X, Y}; +guard_bif('element/2', X, {Pos, Expected}) when element(Pos, X) == Expected -> + {'element/2', X, {Pos, Expected}}; +guard_bif('self/0', X, Y) when self() == Y -> + {'self/0', X, Y}; +guard_bif('node/0', X, Y) when node() == Y -> + {'node/0', X, Y}; +guard_bif('node/1', X, Y) when node(X) == Y -> + {'node/1', X, Y}. diff --git a/lib/hipe/test/basic_SUITE_data/basic_floats.erl b/lib/hipe/test/basic_SUITE_data/basic_floats.erl new file mode 100644 index 0000000000..eec175075a --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_floats.erl @@ -0,0 +1,180 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests that manipulate floating point numbers. +%%%------------------------------------------------------------------- +-module(basic_floats). + +-export([test/0]). +-export([test_fmt_double_fpe_leak/0]). % suppress the unused warning + +test() -> + ok = test_arith_ops(), + ok = test_fp_ebb(), + ok = test_fp_phi(), + ok = test_big_bad_float(), + ok = test_catch_bad_fp_arith(), + ok = test_catch_fp_conv(), + ok = test_fp_with_fp_exceptions(), + %% ok = test_fmt_double_fpe_leak(), % this requires printing + ok. + +%%-------------------------------------------------------------------- + +test_arith_ops() -> + E = 2.5617, + 5.703200000000001 = add(E), + 0.5798000000000001 = sub(E), + 8.047580550000001 = mult(E), + -6.023e23 = negate(6.023e23), + ok. + +add(X) -> + 3.1415 + X. + +sub(X) -> + 3.1415 - X. + +mult(X) -> + 3.1415 * X. + +%% tests the translation of the fnegate BEAM instruction. +negate(X) -> + - (X + 0.0). + +%%-------------------------------------------------------------------- +%% Test the construction of overlapping extended basic blocks where +%% BEAM has constructed one and hipe_icode_fp constructs the other. +%%-------------------------------------------------------------------- + +test_fp_ebb() -> + 1.0 = foo(2 * math:pi()), + 1.0 = bar(2 * math:pi()), + ok. + +foo(X) -> + X / (2 * math:pi()). + +bar(X) -> + F = float_two(), + case F < 3.0 of + true -> (X * F) / ((2 * F) * math:pi()); + false -> weird + end. + +float_two() -> + 2.0. + +%%-------------------------------------------------------------------- + +test_fp_phi() -> + 10 = fp_phi(10, 100), + undefined = fp_phi(1.1e302, 0.000000001), + ok. + +fp_phi(A, B) -> + case catch A / B of + {'EXIT', _Reason} -> undefined; + _ -> round(100 * (A / B)) + end. + +%%-------------------------------------------------------------------- + +-define(BS, "93904329458954829589425849258998492384932849328493284932849328493284932389248329432932483294832949245827588578423578435783475834758375837580745807304258924584295924588459834958349589348589345934859384958349583945893458934859438593485995348594385943859438593458934589345938594385934859483958348934589435894859485943859438594594385938459438595034950439504395043950495043593485943758.0"). + +test_big_bad_float() -> + ok = try f2l(?BS) catch error:badarg -> ok end, + ok = case catch f2l(?BS) of {'EXIT', {badarg, _}} -> ok end, + ok. + +f2l(F) -> + float_to_list(list_to_float(F)). + +%%-------------------------------------------------------------------- +%% Tests catching of floating point bad arithmetic. + +test_catch_bad_fp_arith() -> + 5.7 = f(2.56), + {'EXIT', {badarith, _}} = bad_arith(9.9), + ok. + +f(F) when is_float(F) -> F + 3.14. + +bad_arith(F) when is_float(F) -> + catch F * 1.70000e+308. + +%%-------------------------------------------------------------------- +%% Tests proper catching of exceptions due to illegal convertion of +%% bignums to floating point numbers. + +test_catch_fp_conv() -> + F = 1.7e308, %% F is a number very close to a maximum float. + ok = big_arith(F), + ok = big_const_float(F), + ok. + +big_arith(F) -> + I = trunc(F), + {'EXIT', {badarith, _}} = big_int_arith(I), + ok. + +big_int_arith(I) when is_integer(I) -> + catch(3.0 + 2*I). + +big_const_float(F) -> + I = trunc(F), + badarith = try (1/(2*I)) catch error:Err -> Err end, + _ = 2/I, + {'EXIT', _} = (catch 4/(2*I)), + ok. + +%%-------------------------------------------------------------------- +%% Forces floating point exceptions and tests that subsequent, legal, +%% operations are calculated correctly. + +test_fp_with_fp_exceptions() -> + 0.0 = math:log(1.0), + badarith = try math:log(float_minus_one()) catch error:E1 -> E1 end, + 0.0 = math:log(1.0), + badarith = try math:log(float_zero()) catch error:E2 -> E2 end, + 0.0 = math:log(1.0), + %% An old-fashioned exception here just so as to test this case also + {'EXIT', _} = (catch fp_mult(3.23e133, 3.57e257)), + 0.0 = math:log(1.0), + badarith = try fp_div(5.0, 0.0) catch error:E3 -> E3 end, + 0.0 = math:log(1.0), + ok. + +fp_mult(X, Y) -> X * Y. + +fp_div(X, Y) -> X / Y. + +%% The following two function definitions appear here just to shut +%% off 'expression will fail with a badarg' warnings from the compiler + +float_zero() -> 0.0. + +float_minus_one() -> -1.0. + +%%-------------------------------------------------------------------- +%% Test that erl_printf_format.c:fmt_double() does not leak pending FP +%% exceptions to subsequent code. This used to break x87 FP code on +%% 32-bit x86. Based on a problem report from Richard Carlsson. + +test_fmt_double_fpe_leak() -> + test_fmt_double_fpe_leak(float_zero(), int_two()), + ok. + +%% We need the specific sequence of erlang:display/1 on a float that +%% triggers faulting ops in fmt_double() followed by a simple FP BIF. +%% We also need to repeat this at least three times. +test_fmt_double_fpe_leak(X, Y) -> + erlang:display(X), _ = math:log10(Y), + erlang:display(X), _ = math:log10(Y), + erlang:display(X), _ = math:log10(Y), + erlang:display(X), _ = math:log10(Y), + erlang:display(X), + math:log10(Y). + +int_two() -> 2. diff --git a/lib/hipe/test/basic_SUITE_data/basic_fun.erl b/lib/hipe/test/basic_SUITE_data/basic_fun.erl new file mode 100644 index 0000000000..18ba7fdb3f --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_fun.erl @@ -0,0 +1,124 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Tests for correct handling of funs. +%%%------------------------------------------------------------------- +-module(basic_fun). + +-export([test/0]). + +-export([dummy_foo/4, add1/1, test_fun03/0]). + +test() -> + ok = test_calls(), + ok = test_is_function(), + ok = test_is_function2(), + ok. + +%%-------------------------------------------------------------------- +%% Tests function and fun calls. + +test_calls() -> + ok = test_apply_call(?MODULE, dummy_foo), + ok = test_fun_call(fun dummy_foo/4), + ok = test_fun_call(fun ?MODULE:dummy_foo/4), + ok. + +test_apply_call(M, F) -> + M:F(bar, 42, foo, 17). + +test_fun_call(Fun) -> + Fun(bar, 42, foo, 17). + +dummy_foo(_, _, foo, _) -> ok. + +%%-------------------------------------------------------------------- +%% Tests handling of funs out of exported functions and 2-tuple funs. + +test_fun03() -> + MFPair = add1_as_2tuple(), + 4712 = do_call(add1_as_export(), 4711), + {badfun, MFPair} = try do_call(MFPair, 88) catch error:Err -> Err end, + true = do_guard(add1_as_export()), + false = do_guard(MFPair), % 2-tuples do not satisfy is_function/1 + ok. + +do_call(F, X) -> F(X). + +do_guard(F) when is_function(F) -> true; +do_guard(_) -> false. + +add1_as_export() -> fun ?MODULE:add1/1. + +add1_as_2tuple() -> {?MODULE, add1}. + +add1(X) -> X+1. + +%%-------------------------------------------------------------------- +%% Tests the is_function guard and BIF. + +test_is_function() -> + Fun = fun (X, foo) -> dummy_foo(X, mnesia_lib, foo, [X]) end, + ok = test_when_guard(Fun), + ok = test_if_guard(Fun), + ok. + +test_when_guard(X) when is_function(X) -> ok. + +test_if_guard(X) -> + if is_function(X) -> ok; + true -> weird + end. + +%%-------------------------------------------------------------------- +%% Tests the is_function2 guard and BIF. + +test_is_function2() -> + ok = test_guard(), + ok = test_guard2(), + ok = test_call(), + ok. + +test_guard() -> + zero_fun = test_f2(fun () -> ok end), + unary_fun = test_f2(fun(X) -> X end), + binary_fun = test_f2(fun (X, Y) -> {X, Y} end), + no_fun = test_f2(gazonk), + ok. + +test_f2(Fun) when is_function(Fun, 0) -> + zero_fun; +test_f2(Fun) when is_function(Fun, 1) -> + unary_fun; +test_f2(Fun) when is_function(Fun, 2) -> + binary_fun; +test_f2(_) -> + no_fun. + +test_guard2() -> + zero_fun = test_f2_n(fun () -> ok end, 0), + unary_fun = test_f2_n(fun (X) -> X end, 1), + binary_fun = test_f2_n(fun (X, Y) -> {X, Y} end, 2), + no_fun = test_f2_n(gazonk, 0), + ok. + +test_f2_n(F, N) when is_function(F, N) -> + case N of + 0 -> zero_fun; + 1 -> unary_fun; + 2 -> binary_fun + end; +test_f2_n(_, _) -> + no_fun. + +test_call() -> + true = test_fn2(fun (X, Y) -> {X,Y} end, 2), + false = test_fn2(fun (X, Y) -> {X,Y} end, 3), + false = test_fn2(gazonk, 2), + {'EXIT', {badarg, _TR1}} = (catch test_fn2(gazonk, gazonk)), + {'EXIT', {badarg, _TR2}} = (catch test_fn2(fun (X, Y) -> {X, Y} end, gazonk)), + ok. + +test_fn2(F, N) -> + is_function(F, N). diff --git a/lib/hipe/test/basic_SUITE_data/basic_guards.erl b/lib/hipe/test/basic_SUITE_data/basic_guards.erl new file mode 100644 index 0000000000..81eeed7c3b --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_guards.erl @@ -0,0 +1,164 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests for correct handling of guards and guard BIFs. +%%%------------------------------------------------------------------- +-module(basic_guards). + +-export([test/0]). +%% Prevent the inlining of the following functions +-export([bad_arith/0, bad_tuple/0, is_strange_guard/0]). + +test() -> + ok = guard0(4.2), + ok = guard1([foo]), + ok = test_guard2(), + ok = test_guard3(), + ok = test_guard4(), + ok = test_is_boolean(), + ok = test_bad_guards(), + ok. + +%%-------------------------------------------------------------------- + +guard0(X) when X /= 0, is_float(X) -> + ok. + +guard1(X) when is_atom(X) orelse is_float(X) -> + error1; +guard1(X) when is_reference(hd(X)) -> + error2; +guard1(X) when is_integer(hd(X)) -> + error3; +guard1(X) when hd(X) == foo -> + ok. + +%%-------------------------------------------------------------------- + +test_guard2() -> + ok1 = guard2(true), + not_boolean = guard2(42), + ok2 = guard2(false), + ok. + +guard2(X) when X -> % gets transformed to: is_boolean(X), X =:= true + ok1; +guard2(X) when X =:= false -> + ok2; +guard2(_) -> + not_boolean. + +%%-------------------------------------------------------------------- + +-define(is_foo(X), (is_atom(X) or (is_tuple(X) and (element(1, X) =:= 'foo')))). + +test_guard3() -> + no = f('foo'), + yes = f({'foo', 42}), + no = f(42), + ok. + +f(X) when ?is_foo(X) -> yes; +f(_) -> no. + +%%-------------------------------------------------------------------- + +-define(EXT_REF, <<131,114,0,3,100,0,19,114,101,102,95,116,101,115,116,95,98,117,103,64,103,111,114,98,97,103,2,0,0,0,125,0,0,0,0,0,0,0,0>>). + +test_guard4() -> + yes = is_ref(make_ref()), + no = is_ref(gazonk), + yes = is_ref(an_external_ref(?EXT_REF)), + ok. + +is_ref(Ref) when is_reference(Ref) -> yes; +is_ref(_Ref) -> no. + +an_external_ref(Bin) -> + binary_to_term(Bin). + +%%-------------------------------------------------------------------- + +test_is_boolean() -> + ok = is_boolean_in_if(), + ok = is_boolean_in_guard(). + +is_boolean_in_if() -> + ok1 = tif(true), + ok2 = tif(false), + not_bool = tif(other), + ok. + +is_boolean_in_guard() -> + ok = tg(true), + ok = tg(false), + not_bool = tg(other), + ok. + +tif(V) -> + Yes = yes(), %% just to prevent the optimizer removing this + if + %% the following line generates an is_boolean instruction + V, Yes == yes -> + %% while the following one does not (?!) + %% Yes == yes, V -> + ok1; + not(not(not(V))) -> + ok2; + V -> + ok3; + true -> + not_bool + end. + +tg(V) when is_boolean(V) -> + ok; +tg(_) -> + not_bool. + +yes() -> yes. + +%%-------------------------------------------------------------------- +%% original test by Bjorn G + +test_bad_guards() -> + ok = bad_arith(), + ok = bad_tuple(), + ok = is_strange_guard(), + ok. + +bad_arith() -> + 13 = bad_arith1(1, 12), + 42 = bad_arith1(1, infinity), + 42 = bad_arith1(infinity, 1), + 42 = bad_arith2(infinity, 1), + 42 = bad_arith3(inf), + 42 = bad_arith4(infinity, 1), + ok. + +bad_arith1(T1, T2) when (T1 + T2) < 17 -> T1 + T2; +bad_arith1(_, _) -> 42. + +bad_arith2(T1, T2) when (T1 * T2) < 17 -> T1 * T2; +bad_arith2(_, _) -> 42. + +bad_arith3(T) when (bnot T) < 17 -> T; +bad_arith3(_) -> 42. + +bad_arith4(T1, T2) when (T1 bsr T2) < 10 -> T1 bsr T2; +bad_arith4(_, _) -> 42. + +bad_tuple() -> + error = bad_tuple1(a), + error = bad_tuple1({a, b}), + x = bad_tuple1({x, b}), + y = bad_tuple1({a, b, y}), + ok. + +bad_tuple1(T) when element(1, T) =:= x -> x; +bad_tuple1(T) when element(3, T) =:= y -> y; +bad_tuple1(_) -> error. + +is_strange_guard() when is_tuple({1, bar, length([1, 2, 3, 4]), self()}) -> ok; +is_strange_guard() -> error. diff --git a/lib/hipe/test/basic_SUITE_data/basic_inline_function.erl b/lib/hipe/test/basic_SUITE_data/basic_inline_function.erl new file mode 100644 index 0000000000..4c08064670 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_inline_function.erl @@ -0,0 +1,73 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests that depend on the compiler inliner being turned on. +%%%------------------------------------------------------------------- +-module(basic_inline_function). + +-export([test/0]). + +-compile({inline, [{to_objects, 3}]}). + +test() -> + ok = test_inline_match(), + ok. + +%%-------------------------------------------------------------------- + +test_inline_match() -> + bad_object = test1(a, {binary, foo, set}, c), + bad_object = test2(a, {binary, foo, set}, c), + bad_object = test3(a, {binary, foo, set}, c), + ok. + +%% Inlined +test1(KeysObjs, C, Ts) -> + case catch to_objects(KeysObjs, C, Ts) of + {'EXIT', _} -> + bad_object; + ok -> + ok + end. + +%% "Inlined" by hand +test2(KeysObjs, C, _Ts) -> + case catch (case C of + {binary, _, set} -> + <<_ObjSz0:32, _T/binary>> = KeysObjs; + _ -> ok + end) of + {'EXIT', _} -> + bad_object; + ok -> + ok + end. + +%% Not inlined +test3(KeysObjs, C, Ts) -> + case catch fto_objects(KeysObjs, C, Ts) of + {'EXIT', _} -> + bad_object; + ok -> + ok + end. + +%% Inlined. +to_objects(Bin, {binary, _, set}, _Ts) -> + <<_ObjSz0:32, _T/binary>> = Bin, + ok; +to_objects(<<_ObjSz0:32, _T/binary>> ,_, _) -> + ok; +to_objects(_Bin, _, _Ts) -> + ok. + +%% Not Inlined. +fto_objects(Bin, {binary, _, set}, _Ts) -> + <<_ObjSz0:32, _T/binary>> = Bin, + ok; +fto_objects(<<_ObjSz0:32, _T/binary>> ,_,_) -> + ok; +fto_objects(_Bin, _, _Ts) -> + ok. + diff --git a/lib/hipe/test/basic_SUITE_data/basic_inline_module.erl b/lib/hipe/test/basic_SUITE_data/basic_inline_module.erl new file mode 100644 index 0000000000..306c6a39ce --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_inline_module.erl @@ -0,0 +1,31 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests that depend on the compiler inliner being turned on. +%%%------------------------------------------------------------------- +-module(basic_inline_module). + +-export([test/0]). + +-compile([inline]). %% necessary for these tests + +test() -> + ok = test_case_end_atom(), + ok. + +%%-------------------------------------------------------------------- +%% Tests whether the translation of a case_end instruction works even +%% when an exception (no matching case pattern) is to be raised. + +test_case_end_atom() -> + {'EXIT',{{case_clause,some_atom},_Trace}} = (catch test_case_stm_inlining()), + ok. + +test_case_stm_inlining() -> + case some_atom() of + another_atom -> strange_result + end. + +some_atom() -> + some_atom. diff --git a/lib/hipe/test/basic_SUITE_data/basic_issues_beam.erl b/lib/hipe/test/basic_SUITE_data/basic_issues_beam.erl new file mode 100644 index 0000000000..73367c5c45 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_issues_beam.erl @@ -0,0 +1,326 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains code examples, mostly taken from the mailing list, that +%%% crashed the BEAM compiler or gave an internal error at some point. +%%%------------------------------------------------------------------- +-module(basic_issues_beam). + +-export([test/0]). + +test() -> + ok = test_crash_R10_hinde(), + ok = test_error_R10_mander(), + ok = test_error_R11_bjorklund(), + ok = test_error_R11_rath(), + ok = test_error_R12_empty_bin_rec(), + ok = test_bug_R12_cornish(), + ok = test_crash_R12_morris(), + ok = test_error_R13_almeida(), + ok = test_error_R13B01_fisher(), + ok = test_error_R13B01_sawatari(), + ok = test_error_R13B01_whongo(), + ok = test_error_R16B03_norell(), + ok = test_error_try_wings(), + ok. + +%%-------------------------------------------------------------------- +%% Fisher R10 compiler crash +%%-------------------------------------------------------------------- + +-record(r, {a, b, c}). + +test_crash_R10_hinde() -> + rec_R10_hinde(#r{}). + +rec_R10_hinde(As) -> + case As of + A when A#r.b == ""; A#r.b == undefined -> ok; + _ -> error + end. + +%%-------------------------------------------------------------------- +%% From: Peter-Henry Mander +%% Date: 27 Jan, 2005 +%% +%% I managed to isolate a non-critical BEAM compilation error +%% (internal error in v3_codegen) when compiling the following code: +%%-------------------------------------------------------------------- + +test_error_R10_mander() -> + try just_compile_me_R10() catch _:_ -> ok end. + +just_compile_me_R10() -> + URI_Before = + {absoluteURI, + {scheme, fun() -> nil end}, + {hier_part, + {net_path, + {srvr, + {userinfo, nil}, + fun() -> nil end}, + nil}, + {port, nil}}}, + {absoluteURI, + {scheme, _}, + {hier_part, + {net_path, + {srvr, + {userinfo, nil}, + _HostportBefore}, + nil}, + {port, nil}}} = URI_Before, + %% ... some funky code ommitted, not relevant ... + {absoluteURI, + {scheme, _}, + {hier_part, + {net_path, + {srvr, + {userinfo, nil}, + HostportAfter}, + nil}, + {port, nil}}} = URI_Before, + %% NOTE: I intended to write URI_After instead of URI_Before + %% but the accident revealed that when you add the line below, + %% it causes internal error in v3_codegen on compilation + {hostport, {hostname, "HostName"}, {port, nil}} = HostportAfter, + ok. + +%%-------------------------------------------------------------------- +%% From: Martin Bjorklund +%% Date: Aug 16, 2006 +%% +%% I found this compiler bug in R10B-10 and R11B-0. +%% +%% Function -just_compile_me/0-fun-2-/1 refers to undefined label 18 +%% ./bjorklund_R11compiler_bug.erl:none: internal error in beam_clean; +%% crash reason: {{case_clause,{'EXIT',{undefined_label,18}}}, +%% [{compile,'-select_passes/2-anonymous-2-',2}, +%% {compile,'-internal_comp/4-anonymous-1-',2}, +%% {compile,fold_comp,3}, +%% {compile,internal_comp,4}, +%% {compile,internal,3}]} +%%-------------------------------------------------------------------- + +test_error_R11_bjorklund() -> + just_compile_me_R11_bjorklund(). + +just_compile_me_R11_bjorklund() -> + G = fun() -> ok end, + try + G() %% fun() -> ok end + after + fun({A, B}) -> A + B end + end. + +%%-------------------------------------------------------------------- +%% From: Tim Rath +%% Date: Sep 13, 2006 +%% Subject: Compiler bug not quite fixed +%% +%% +%% I saw a compiler bug posted to the list by Martin Bjorklund that +%% appeared to be exactly the problem I'm seeing, and then noticed +%% that this was fixed in R11B-1. Unfortunately, though R11B-1 appears +%% to fix the code submitted by Martin, it does not fix my case. +%% +%% Function -just_compile_me/0-fun-2-/1 refers to undefined label 13 +%% ./rath_R11compiler_bug.erl:none: internal error in beam_clean; +%% crash reason: {{case_clause,{'EXIT',{undefined_label,13}}}, +%% [{compile,'-select_passes/2-anonymous-2-',2}, +%% {compile,'-internal_comp/4-anonymous-1-',2}, +%% {compile,fold_comp,3}, +%% {compile,internal_comp,4}, +%% {compile,internal,3}]} +%%-------------------------------------------------------------------- + +test_error_R11_rath() -> + just_compile_me_R11_rath(). + +just_compile_me_R11_rath() -> + A = {6}, + try + io:fwrite("") + after + fun () -> + fun () -> {_} = A end + end + end. + +%%---------------------------------------------------------------------- +%% Program that crashed the R12B-0 compiler: internal error in v3_codegen +%%---------------------------------------------------------------------- + +-record(rec, {a = <<>> :: binary(), b = 42 :: integer()}). + +test_error_R12_empty_bin_rec() -> + 42 = test_empty_bin_rec(#rec{}), + ok. + +test_empty_bin_rec(R) -> + #rec{a = <<>>} = R, + R#rec.b. + +%%---------------------------------------------------------------------- +%% From: Simon Cornish +%% Date: Jan 13, 2008 +%% +%% The attached Erlang code demonstrates an R12B-0 bug with funs. +%% Compile and evaluate the two die/1 calls for two different failure modes. +%% It seems to me that the live register check for call_fun is off by one. +%%---------------------------------------------------------------------- + +-record(b, {c}). + +test_bug_R12_cornish() -> + {a2, a} = die(a), + {a2, {b, c}} = die({b, c}), + ok. + +die(A) -> + F = fun() -> {ok, A} end, + if A#b.c =:= [] -> one; + true -> + case F() of + {ok, A2} -> {a2, A2}; + _ -> three + end + end. + +%%---------------------------------------------------------------------- +%% From: Hunter Morris +%% Date: Nov 20, 2008 +%% +%% The following code (tested with R12B-4 or R12B-5, vanilla compiler +%% options) produces a compiler crash. It's nonsensical, and I realise +%% that andalso can be quite evil, but it's a crash nonetheless. +%%---------------------------------------------------------------------- + +test_crash_R12_morris() -> + foo(42). + +foo(Bar) when (is_integer(Bar) andalso Bar =:= 0) ; Bar =:= 42 -> + ok. + +%%-------------------------------------------------------------------- +%% From: Paulo Sergio Almeida +%% Date: May 20, 2009 +%% +%% The following code when compiled under R13B gives a compiler error. +%% Function loop/1 refers to undefined label 6 +%% ./almeida_R13compiler_bug.erl:none: internal error in beam_peep; +%% crash reason: {{case_clause,{'EXIT',{undefined_label,6}}}, +%% [{compile,'-select_passes/2-anonymous-2-',2}, +%% {compile,'-internal_comp/4-anonymous-1-',2}, +%%-------------------------------------------------------------------- + +test_error_R13_almeida() -> + self() ! {backup, 42, false}, + loop([]). + +loop(Tids) -> + receive + {backup, Tid, Dumping} -> + case Dumping of + false -> ok; + _ -> receive {logged, Tab, Tid} -> put({log, Tab}, Tid) end + end, + collect(Tid, Tids, []) + end. + +collect(_, _, _) -> ok. + +%%-------------------------------------------------------------------- +%% Fisher R13B01 compiler error +%%-------------------------------------------------------------------- + +test_error_R13B01_fisher() -> + perform_select({foo, "42"}). + +perform_select({Type, Keyval}) -> + try + if is_atom(Type) andalso length(Keyval) > 0 -> ok; + true -> ok + end + catch + _:_ -> fail + end. + +%%-------------------------------------------------------------------- +%% From: Mikage Sawatari +%% Date: Jun 12, 2009 +%% +%% I have the following compilation problem on Erlang R13B01. +%% Compiler reports "Internal consistency check failed". +%%-------------------------------------------------------------------- + +test_error_R13B01_sawatari() -> + test_sawatari([1, null, 3], <<1, 2, 3>>). + +test_sawatari([], _Bin) -> ok; +test_sawatari([H|T], Bin) -> + _ = case H of + null -> <<Bin/binary>>; + _ -> ok + end, + test_sawatari(T, Bin). + +%%-------------------------------------------------------------------- + +test_error_R13B01_whongo() -> + S = "gazonk", + S = orgno_alphanum(S), + ok. + +orgno_alphanum(Cs) -> + [C || C <- Cs, ((C >= $0) andalso (C =< $9)) + orelse ((C >= $a) andalso (C =< $z)) + orelse ((C >= $A) andalso (C =< $Z))]. + +%%-------------------------------------------------------------------- +%% I'm getting an Internal Consistency Check error when attempting to +%% build Wings3D on Mac OS X 10.4.2 (Erlang OTP R10B-6): +%% +%% erlc -pa /ebin +warn_unused_vars -I/include -I ../e3d -W +debug_info +%% '-Dwings_version="0.98.31"' -pa ../ebin -o../ebin wings_color.erl +%% wings_color: function internal_rgb_to_hsv/3+97: +%% Internal consistency check failed - please report this bug. +%% Instruction: {test,is_eq_exact,{f,80},[{x,0},{atom,error}]} +%% Error: {unsafe_instruction,{float_error_state,cleared}}: +%% +%% The problem is the interaction of the 'try' construct with the +%% handling of FP exceptions. +%%-------------------------------------------------------------------- + +test_error_try_wings() -> + %% a call with a possible FP exception + {199.99999999999997, 0.045454545454545456, 44} = rgb_to_hsv(42, 43, 44), + ok. + +rgb_to_hsv(R, G, B) -> + Max = lists:max([R, G, B]), + Min = lists:min([R, G, B]), + V = Max, + {Hue, Sat} = try + {if Min == B -> (G-Min)/(R+G-2.0*Min); + Min == R -> (1.0+(B-Min)/(B+G-2.0*Min)); + Min == G -> (2.0+(R-Min)/(B+R-2.0*Min)) + end * 120, (Max-Min)/Max} + catch + error:badarith -> {undefined, 0.0} + end, + {Hue, Sat, V}. + +%%-------------------------------------------------------------------- +%% From: Ulf Norell +%% Date: Feb 28, 2014 +%% +%% This caused an internal error in v3_codegen +%%-------------------------------------------------------------------- + +test_error_R16B03_norell() -> + test_error_R16B03_norell(#r{}, gazonk). + +test_error_R16B03_norell(Rec, Tag) -> + is_record(Rec, Tag, 3) orelse ok. diff --git a/lib/hipe/test/basic_SUITE_data/basic_issues_hipe.erl b/lib/hipe/test/basic_SUITE_data/basic_issues_hipe.erl new file mode 100644 index 0000000000..e71045bfe2 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_issues_hipe.erl @@ -0,0 +1,153 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains code examples that exhibited crashes in the HiPE compiler. +%%%------------------------------------------------------------------- +-module(basic_issues_hipe). + +-export([test/0]). + +%% functions that need to be exported so that they are retained. +-export([auth/4]). + +test() -> + ok = test_dominance_trees(), + ok = test_merged_const(), + ok = test_var_pair(), + ok = test_bif_fails(), + ok = test_find_catches(), + ok = test_heap_allocate_trim(), + ok. + +%%-------------------------------------------------------------------- +%% This is taken from a file sent to us by Martin Bjorklund @ Nortel +%% on 14th November 2004. The problem was in the SSA unconvert pass. +%% +%% No tests here; we simply check that the HiPE compiler does not go +%% into an infinite loop when compiling strange functions like this. +%%-------------------------------------------------------------------- + +auth(_, A, B, C) -> + auth(A, B, C, []). + +%%-------------------------------------------------------------------- +%% Exposed a crash in the generation of dominance trees used in SSA. +%%-------------------------------------------------------------------- + +-record(state, {f}). + +test_dominance_trees() -> + {ok, true} = doit(true, #state{f = true}), + ok. + +doit(Foo, S) -> + Fee = case Foo of + Bar when Bar == S#state.f; Bar == [] -> true; + _ -> false + end, + {ok, Fee}. + +%%-------------------------------------------------------------------- +%% Checks that the merging of constants in the constant table uses the +%% appropriate comparison function for this. +%%-------------------------------------------------------------------- + +test_merged_const() -> + Const1 = {'', 1.0000}, + Const2 = {'', 1}, + match(Const1, Const2). + +match(A, A) -> + error; +match(_A, _B) -> + ok. + +%%-------------------------------------------------------------------- +%% Checks that the HiPE compiler does not get confused by constant +%% data structures similar to the internal compiler data structures. +%%-------------------------------------------------------------------- + +test_var_pair() -> + ok = var_pair([gazonk]). + +var_pair([_|_]) -> + var_pair({var, some_atom}); +var_pair(_) -> + ok. + +%%-------------------------------------------------------------------- +%% This module was causing the HiPE compiler to crash in January 2007. +%% The culprit was an "optimization" of the BEAM compiler: postponing +%% the save of x variables when BIFs cannot fail. This was fixed on +%% February 1st, by making the HiPE compiler use the same functions +%% as the BEAM compiler for deciding whether a BIF fails. +%%-------------------------------------------------------------------- + +test_bif_fails() -> + [42] = bif_fails_in_catch([42]), + true = bif_fails_in_try([42]), + ok. + +bif_fails_in_catch(X) -> + case catch get(gazonk) of + _ -> X + end. + +bif_fails_in_try(X) -> + try + true = X =/= [] + catch + _ -> nil(X) + end. + +nil(_) -> []. + +%%-------------------------------------------------------------------- +%% Test that resulted in a native code compiler crash in the code of +%% hipe_icode_exceptions:find_catches/1 when compiling find_catches/2. +%%-------------------------------------------------------------------- + +test_find_catches() -> + 42 = find_catches(a, false), + ok. + +find_catches(X, Y) -> + case X of + a when Y =:= true -> + catch id(X), + X; + b when Y =:= true -> + catch id(X), + X; + a -> + catch id(X), + 42; + b -> + catch id(X), + 42 + end. + +id(X) -> X. + +%%-------------------------------------------------------------------- +%% Date: Dec 28, 2007 +%% +%% This is a test adapted from the file sent to the Erlang mailing +%% list by Eranga Udesh. The file did not compile because of problems +%% with the heap_allocate instruction and stack trimming. +%%-------------------------------------------------------------------- + +test_heap_allocate_trim() -> + {abandon, 42} = get_next_retry(a, 42), + ok. + +get_next_retry(Error, Count) -> + case catch pair(retry_scheme, {Error, Count}) of + _ -> + case pair(Error, Count) of + _ -> {abandon, Count} + end + end. + +pair(A, B) -> {A, B}. diff --git a/lib/hipe/test/basic_SUITE_data/basic_lists.erl b/lib/hipe/test/basic_SUITE_data/basic_lists.erl new file mode 100644 index 0000000000..264a7f86f6 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_lists.erl @@ -0,0 +1,61 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests that manipulate and pattern match against lists +%%% (perhaps by calling functions from the 'lists' module). +%%%------------------------------------------------------------------- +-module(basic_lists). + +-export([test/0]). + +test() -> + ok = test_length(), + ok = test_lists_key(), + ok = test_lists_and_strings(), + ok. + +%%-------------------------------------------------------------------- + +test_length() -> + Len = 42, + Lst = mklist(Len, []), + Len = iterate(100, Lst), + ok. + +mklist(0, L) -> L; +mklist(X, L) -> mklist(X-1, [X|L]). + +iterate(0, L) -> len(L, 0); +iterate(X, L) -> len(L, 0), iterate(X-1, L). + +len([_|X], L) -> len(X, L+1); +len([], L) -> L. + +%%-------------------------------------------------------------------- + +test_lists_key() -> + First = {x, 42.0}, + Second = {y, -77}, + Third = {z, [a, b, c], {5.0}}, + List = [First, Second, Third], + {value, First} = key_search_find(42, 2, List), + ok. + +key_search_find(Key, Pos, List) -> + case lists:keyfind(Key, Pos, List) of + false -> + false = lists:keysearch(Key, Pos, List); + Tuple when is_tuple(Tuple) -> + {value, Tuple} = lists:keysearch(Key, Pos, List) + end. + +%%-------------------------------------------------------------------- + +test_lists_and_strings() -> + LL = ["H'A", " H'B", " H'C"], + LL2 = lists:map(fun string:strip/1, LL), + HexFormat = fun(X, Acc) -> {string:substr(X, 3), Acc} end, + {LL3,_Ret} = lists:mapfoldl(HexFormat, 0, LL2), + ["A", "B", "C"] = lists:sublist(LL3, 42), + ok. diff --git a/lib/hipe/test/basic_SUITE_data/basic_module_info.erl b/lib/hipe/test/basic_SUITE_data/basic_module_info.erl new file mode 100644 index 0000000000..cab48b10ba --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_module_info.erl @@ -0,0 +1,32 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% Date: Oct 25, 2003 +%%% +%%% Tests whether calling module_info from the same module works. +%%% This seems trivial, but the problem is that the module_info/[0,1] +%%% functions that the BEAM file contains used to be dummy functions +%%% containing crap. So, these functions could not be used for +%%% compilation to native code and the functions that the BEAM loader +%%% generates should have been used instead. This was a HiPE bug +%%% reported by Dan Wallin. +%%%------------------------------------------------------------------- +-module(basic_module_info). + +-export([test/0]). + +test() -> + L = test_local_mi0_call(), + E = test_remote_mi1_call(), + {3, 3} = {L, E}, + ok. + +test_local_mi0_call() -> + ModInfo = module_info(), + %% io:format("ok, ModInfo=~w\n", [ModInfo]), + {exports, FunList} = lists:keyfind(exports, 1, ModInfo), + length(FunList). + +test_remote_mi1_call() -> + FunList = ?MODULE:module_info(exports), + length(FunList). diff --git a/lib/hipe/test/basic_SUITE_data/basic_pattern_match.erl b/lib/hipe/test/basic_SUITE_data/basic_pattern_match.erl new file mode 100644 index 0000000000..93240354a7 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_pattern_match.erl @@ -0,0 +1,46 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains code examples that test pattern matching against terms of +%%% various types. +%%%------------------------------------------------------------------- +-module(basic_pattern_match). + +-export([test/0]). + +test() -> + ok = test_hello_world(), + ok = test_list_plus_plus_match(), + ok. + +%%-------------------------------------------------------------------- +%% Trivial test to test pattern matching compilation with atoms, the +%% correct handling of all sorts of alphanumeric types in Erlang, and +%% conversions between them. + +test_hello_world() -> + String = gimme(string), + String = atom_to_list(gimme(atom)), + String = binary_to_list(gimme(binary)), + true = (list_to_atom(String) =:= gimme(atom)), + true = (list_to_binary(String) =:= gimme(binary)), + ok. + +gimme(string) -> + "hello world"; +gimme(atom) -> + 'hello world'; +gimme(binary) -> + <<"hello world">>. + +%%-------------------------------------------------------------------- +%% Makes sure that pattern matching expressions involving ++ work OK. +%% The third expression caused a problem in the Erlang shell of R11B-5. +%% It worked OK in both interpreted and compiled code. + +test_list_plus_plus_match() -> + ok = (fun("X" ++ _) -> ok end)("X"), + ok = (fun([$X | _]) -> ok end)("X"), + ok = (fun([$X] ++ _) -> ok end)("X"), + ok. diff --git a/lib/hipe/test/basic_SUITE_data/basic_random.erl b/lib/hipe/test/basic_SUITE_data/basic_random.erl new file mode 100644 index 0000000000..783947bd31 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_random.erl @@ -0,0 +1,238 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% A test for list handling created using the 'random' module. +%%%------------------------------------------------------------------- +-module(basic_random). + +-export([test/0]). + +%% It can be used as a benchmark by playing with the following defines +-define(N, 1000). +-define(Iter, 500). + +test() -> + ok = random(?N). + +random(N) -> + random(N, ?Iter). + +random(N, Iter) -> + random:seed(1, 2, 3), + t(ranlist(N, [], N*100), Iter). + +ranlist(0, L, _N) -> L; +ranlist(N, L, N0) -> ranlist(N-1, [random:uniform(N0)+300 | L], N0). + +t(_, 0) -> ok; +t(L, Iter) -> + %% io:format("Sort starting~n"), + sort(L), + t(L, Iter-1). + +sort([X, Y | L]) when X =< Y -> + split_1(X, Y, L, [], []); +sort([X, Y | L]) -> + split_2(X, Y, L, [], []); +sort(L) -> + L. + +%% Ascending. +split_1(X, Y, [Z | L], R, Rs) when Z >= Y -> + split_1(Y, Z, L, [X | R], Rs); +split_1(X, Y, [Z | L], R, Rs) when Z >= X -> + split_1(Z, Y, L, [X | R], Rs); +split_1(X, Y, [Z | L], [], Rs) -> + split_1(X, Y, L, [Z], Rs); +split_1(X, Y, [Z | L], R, Rs) -> + split_1_1(X, Y, L, R, Rs, Z); +split_1(X, Y, [], R, Rs) -> + rmergel([[Y, X | R] | Rs], []). + +%% One out-of-order element, S. +split_1_1(X, Y, [Z | L], R, Rs, S) when Z >= Y -> + split_1_1(Y, Z, L, [X | R], Rs, S); +split_1_1(X, Y, [Z | L], R, Rs, S) when Z >= X -> + split_1_1(Z, Y, L, [X | R], Rs, S); +split_1_1(X, Y, [Z | L], R, Rs, S) when S =< Z -> + split_1(S, Z, L, [], [[Y, X | R] | Rs]); +split_1_1(X, Y, [Z | L], R, Rs, S) -> + split_1(Z, S, L, [], [[Y, X | R] | Rs]); +split_1_1(X, Y, [], R, Rs, S) -> + rmergel([[S], [Y, X | R] | Rs], []). + +%% Descending. +split_2(X, Y, [Z | L], R, Rs) when Z =< Y -> + split_2(Y, Z, L, [X | R], Rs); +split_2(X, Y, [Z | L], R, Rs) when Z =< X -> + split_2(Z, Y, L, [X | R], Rs); +split_2(X, Y, [Z | L], [], Rs) -> + split_2(X, Y, L, [Z], Rs); +split_2(X, Y, [Z | L], R, Rs) -> + split_2_1(X, Y, L, R, Rs, Z); +split_2(X, Y, [], R, Rs) -> + mergel([[Y, X | R] | Rs], []). + +split_2_1(X, Y, [Z | L], R, Rs, S) when Z =< Y -> + split_2_1(Y, Z, L, [X | R], Rs, S); +split_2_1(X, Y, [Z | L], R, Rs, S) when Z =< X -> + split_2_1(Z, Y, L, [X | R], Rs, S); +split_2_1(X, Y, [Z | L], R, Rs, S) when S > Z -> + split_2(S, Z, L, [], [[Y, X | R] | Rs]); +split_2_1(X, Y, [Z | L], R, Rs, S) -> + split_2(Z, S, L, [], [[Y, X | R] | Rs]); +split_2_1(X, Y, [], R, Rs, S) -> + mergel([[S], [Y, X | R] | Rs], []). + +mergel([[] | L], Acc) -> + mergel(L, Acc); +mergel([A, [H2 | T2], [H3 | T3] | L], Acc) -> + mergel(L, [merge3_1(A, [], H2, T2, H3, T3) | Acc]); +mergel([A, [H | T]], Acc) -> + rmergel([merge2_1(A, H, T, []) | Acc], []); +mergel([L], []) -> + L; +mergel([L], Acc) -> + rmergel([lists:reverse(L, []) | Acc], []); +mergel([], []) -> + []; +mergel([], Acc) -> + rmergel(Acc, []); +mergel([A, [] | L], Acc) -> + mergel([A | L], Acc); +mergel([A, B, [] | L], Acc) -> + mergel([A, B | L], Acc). + +rmergel([A, [H2 | T2], [H3 | T3] | L], Acc) -> + rmergel(L, [rmerge3_1(A, [], H2, T2, H3, T3) | Acc]); +rmergel([A, [H | T]], Acc) -> + mergel([rmerge2_1(A, H, T, []) | Acc], []); +rmergel([L], Acc) -> + mergel([lists:reverse(L, []) | Acc], []); +rmergel([], Acc) -> + mergel(Acc, []). + +%% Take L1 apart. +merge3_1([H1 | T1], M, H2, T2, H3, T3) when H1 =< H2 -> + merge3_12(T1, H1, H2, T2, H3, T3, M); +merge3_1([H1 | T1], M, H2, T2, H3, T3) -> + merge3_21(T1, H1, H2, T2, H3, T3, M); +merge3_1(_nil, M, H2, T2, H3, T3) when H2 =< H3 -> + merge2_1(T2, H3, T3, [H2 | M]); +merge3_1(_nil, M, H2, T2, H3, T3) -> + merge2_1(T3, H2, T2, [H3 | M]). + +%% Take L2 apart. +merge3_2(T1, H1, M, [H2 | T2], H3, T3) when H1 =< H2 -> + merge3_12(T1, H1, H2, T2, H3, T3, M); +merge3_2(T1, H1, M, [H2 | T2], H3, T3) -> + merge3_21(T1, H1, H2, T2, H3, T3, M); +merge3_2(T1, H1, M, _nil, H3, T3) when H1 =< H3 -> + merge2_1(T1, H3, T3, [H1 | M]); +merge3_2(T1, H1, M, _nil, H3, T3) -> + merge2_1(T3, H1, T1, [H3 | M]). + +%% H1 <= H2. Inlined. +merge3_12(T1, H1, H2, T2, H3, T3, M) when H3 < H1 -> + merge3_12_3(T1, H1, H2, T2, [H3 | M], T3); +merge3_12(T1, H1, H2, T2, H3, T3, M) -> + merge3_1(T1, [H1 | M], H2, T2, H3, T3). + +%% H1 <= H2, take L3 apart. +merge3_12_3(T1, H1, H2, T2, M, [H3 | T3]) when H3 < H1 -> + merge3_12_3(T1, H1, H2, T2, [H3 | M], T3); +merge3_12_3(T1, H1, H2, T2, M, [H3 | T3]) -> + merge3_1(T1, [H1 | M], H2, T2, H3, T3); +merge3_12_3(T1, H1, H2, T2, M, _nil) -> + merge2_1(T1, H2, T2, [H1 | M]). + +%% H1 > H2. Inlined. +merge3_21(T1, H1, H2, T2, H3, T3, M) when H3 < H2 -> + merge3_21_3(T1, H1, H2, T2, [H3 | M], T3); +merge3_21(T1, H1, H2, T2, H3, T3, M) -> + merge3_2(T1, H1, [H2 | M], T2, H3, T3). + +%% H1 > H2, take L3 apart. +merge3_21_3(T1, H1, H2, T2, M, [H3 | T3]) when H3 < H2 -> + merge3_21_3(T1, H1, H2, T2, [H3 | M], T3); +merge3_21_3(T1, H1, H2, T2, M, [H3 | T3]) -> + merge3_2(T1, H1, [H2 | M], T2, H3, T3); +merge3_21_3(T1, H1, H2, T2, M, _nil) -> + merge2_1(T2, H1, T1, [H2 | M]). + +%% Take L1 apart. +rmerge3_1([H1 | T1], M, H2, T2, H3, T3) when H1 > H2 -> + rmerge3_12(T1, H1, H2, T2, H3, T3, M); +rmerge3_1([H1 | T1], M, H2, T2, H3, T3) -> + rmerge3_21(T1, H1, H2, T2, H3, T3, M); +rmerge3_1(_nil, M, H2, T2, H3, T3) when H2 > H3 -> + rmerge2_1(T2, H3, T3, [H2 | M]); +rmerge3_1(_nil, M, H2, T2, H3, T3) -> + rmerge2_1(T3, H2, T2, [H3 | M]). + +%% Take L2 apart. +rmerge3_2(T1, H1, M, [H2 | T2], H3, T3) when H1 > H2 -> + rmerge3_12(T1, H1, H2, T2, H3, T3, M); +rmerge3_2(T1, H1, M, [H2 | T2], H3, T3) -> + rmerge3_21(T1, H1, H2, T2, H3, T3, M); +rmerge3_2(T1, H1, M, _nil, H3, T3) when H1 > H3 -> + rmerge2_1(T1, H3, T3, [H1 | M]); +rmerge3_2(T1, H1, M, _nil, H3, T3) -> + rmerge2_1(T3, H1, T1, [H3 | M]). + +%% H1 > H2. Inlined. +rmerge3_12(T1, H1, H2, T2, H3, T3, M) when H3 >= H1 -> + rmerge3_12_3(T1, H1, H2, T2, [H3 | M], T3); +rmerge3_12(T1, H1, H2, T2, H3, T3, M) -> + rmerge3_1(T1, [H1 | M], H2, T2, H3, T3). + +%% H1 > H2, take L3 apart. +rmerge3_12_3(T1, H1, H2, T2, M, [H3 | T3]) when H3 >= H1 -> + rmerge3_12_3(T1, H1, H2, T2, [H3 | M], T3); +rmerge3_12_3(T1, H1, H2, T2, M, [H3 | T3]) -> + rmerge3_1(T1, [H1 | M], H2, T2, H3, T3); +rmerge3_12_3(T1, H1, H2, T2, M, _nil) -> + rmerge2_1(T1, H2, T2, [H1 | M]). + +%% H1 =< H2. Inlined. +rmerge3_21(T1, H1, H2, T2, H3, T3, M) when H3 >= H2 -> + rmerge3_21_3(T1, H1, H2, T2, [H3 | M], T3); +rmerge3_21(T1, H1, H2, T2, H3, T3, M) -> + rmerge3_2(T1, H1, [H2 | M], T2, H3, T3). + +%% H1 =< H2, take L3 apart. +rmerge3_21_3(T1, H1, H2, T2, M, [H3 | T3]) when H3 >= H2 -> + rmerge3_21_3(T1, H1, H2, T2, [H3 | M], T3); +rmerge3_21_3(T1, H1, H2, T2, M, [H3 | T3]) -> + rmerge3_2(T1, H1, [H2 | M], T2, H3, T3); +rmerge3_21_3(T1, H1, H2, T2, M, _nil) -> + rmerge2_1(T2, H1, T1, [H2 | M]). + +merge2_1([H1 | T1], H2, T2, M) when H2 < H1 -> + merge2_2(T1, H1, T2, [H2 | M]); +merge2_1([H1 | T1], H2, T2, M) -> + merge2_1(T1, H2, T2, [H1 | M]); +merge2_1(_nil, H2, T2, M) -> + lists:reverse(T2, [H2 | M]). + +merge2_2(T1, H1, [H2 | T2], M) when H1 < H2 -> + merge2_1(T1, H2, T2, [H1 | M]); +merge2_2(T1, H1, [H2 | T2], M) -> + merge2_2(T1, H1, T2, [H2 | M]); +merge2_2(T1, H1, _nil, M) -> + lists:reverse(T1, [H1 | M]). + +rmerge2_1([H1 | T1], H2, T2, M) when H2 >= H1 -> + rmerge2_2(T1, H1, T2, [H2 | M]); +rmerge2_1([H1 | T1], H2, T2, M) -> + rmerge2_1(T1, H2, T2, [H1 | M]); +rmerge2_1(_nil, H2, T2, M) -> + lists:reverse(T2, [H2 | M]). + +rmerge2_2(T1, H1, [H2 | T2], M) when H1 >= H2 -> + rmerge2_1(T1, H2, T2, [H1 | M]); +rmerge2_2(T1, H1, [H2 | T2], M) -> + rmerge2_2(T1, H1, T2, [H2 | M]); +rmerge2_2(T1, H1, _nil, M) -> + lists:reverse(T1, [H1 | M]). diff --git a/lib/hipe/test/basic_SUITE_data/basic_receive.erl b/lib/hipe/test/basic_SUITE_data/basic_receive.erl new file mode 100644 index 0000000000..5f865d7b7a --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_receive.erl @@ -0,0 +1,56 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains code examples that test correct handling of receives. +%%%------------------------------------------------------------------- +-module(basic_receive). + +-export([test/0]). + +test() -> + ok = test_wait_timeout(), + ok = test_double_timeout(), + ok = test_reschedule(), + ok. + +%%-------------------------------------------------------------------- + +test_wait_timeout() -> + receive after 42 -> ok end. + +%%-------------------------------------------------------------------- + +test_double_timeout() -> + self() ! foo, + self() ! another_foo, + receive + non_existent -> weird + after 0 -> timeout + end, + receive + foo -> ok + after 1000 -> timeout + end. + +%%-------------------------------------------------------------------- +%% Check that RESCHEDULE returns from BIFs work. + +test_reschedule() -> + erts_debug:set_internal_state(available_internal_state, true), + First = self(), + Second = spawn(fun() -> doit(First) end), + receive + Second -> ok + end, + receive + after 42 -> ok + end, + erts_debug:set_internal_state(hipe_test_reschedule_resume, Second), + ok. + +doit(First) -> + First ! self(), + erts_debug:set_internal_state(hipe_test_reschedule_suspend, 1). + +%%-------------------------------------------------------------------- diff --git a/lib/hipe/test/basic_SUITE_data/basic_records.erl b/lib/hipe/test/basic_SUITE_data/basic_records.erl new file mode 100644 index 0000000000..cbb451196c --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_records.erl @@ -0,0 +1,28 @@ +%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests that manipulate and pattern match against records. +%%%------------------------------------------------------------------- +-module(basic_records). + +-export([test/0]). + +test() -> + ok = test_rec1(), + ok. + +%%-------------------------------------------------------------------- + +-record(r, {ra}). +-record(s, {sa, sb, sc, sd}). + +test_rec1() -> + R = #r{}, + S = #s{}, + S1 = S#s{sc=R, sd=1}, + R1 = S1#s.sc, + undefined = R1#r.ra, + ok. + +%%-------------------------------------------------------------------- diff --git a/lib/hipe/test/basic_SUITE_data/basic_strength_reduce.erl b/lib/hipe/test/basic_SUITE_data/basic_strength_reduce.erl new file mode 100644 index 0000000000..0f94320a33 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_strength_reduce.erl @@ -0,0 +1,65 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Tests the strength reduction component of the HiPE compiler. +%%%------------------------------------------------------------------- +-module(basic_strength_reduce). + +-export([test/0]). +%% These functions are exported so as to not remove them by inlining +-export([crash_0/1, crash_1/1, crash_2/1, crash_3/1, bug_div_2N/1]). + +test() -> + ok = test_strength_reduce1(), + ok. + +%%-------------------------------------------------------------------- + +test_strength_reduce1() -> + ok = crash_0(0), + ok = crash_1(42), + ok = crash_2(42), + ok = crash_3(42), + 5 = 42 bsr 3 = bug_div_2N(42), + -6 = -42 bsr 3 = bug_div_2N(-42) - 1, + ok. + +%% This is a crash report by Peter Wang (10 July 2007) triggering an +%% R11B-5 crash: strength reduction could not handle calls with no +%% destination +crash_0(A) -> + case A of + 0 -> + A div 8, + ok + end. + +%% The above was simplified to the following which showed another +%% crash, this time on RTL +crash_1(A) when is_integer(A), A >= 0 -> + A div 8, + ok. + +%% A similar crash like the first one, but in a different place in the +%% code, was triggered by the following code +crash_2(A) when is_integer(A), A >= 0 -> + A div 1, + ok. + +%% A crash similar to the first one happened in the following code +crash_3(A) -> + case A of + 42 -> + A * 0, + ok + end. + +%% Strength reduction for div/2 and rem/2 with a power of 2 +%% should be performed only for non-negative integers +bug_div_2N(X) when is_integer(X), X >= 0 -> + X div 8; +bug_div_2N(X) when is_integer(X), X < 0 -> + X div 8. + +%%-------------------------------------------------------------------- diff --git a/lib/hipe/test/basic_SUITE_data/basic_switches.erl b/lib/hipe/test/basic_SUITE_data/basic_switches.erl new file mode 100644 index 0000000000..0a7ae5b8b7 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_switches.erl @@ -0,0 +1,52 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests for pattern matching switches. +%%%------------------------------------------------------------------- +-module(basic_switches). + +-export([test/0]). + +test() -> + ok = test_switch_mix(), + ok. + +%%--------------------------------------------------------------------- + +-define(BIG1, 21323233222132323322). +-define(BIG2, 4242424242424242424242424242424242). + +test_switch_mix() -> + small1 = t(42), + small2 = t(17), + big1 = t(?BIG1), + big2 = t(?BIG2), + atom = t(foo), + pid = t(self()), + float = t(4.2), + ok. + +t(V) -> + S = self(), + case V of + 42 -> small1; + 17 -> small2; + ?BIG1 -> big1; + ?BIG2 -> big2; + 1 -> no; + 2 -> no; + 3 -> no; + 4 -> no; + 5 -> no; + 6 -> no; + 7 -> no; + 8 -> no; + foo -> atom; + 9 -> no; + 4.2 -> float; + S -> pid; + _ -> no + end. + +%%--------------------------------------------------------------------- diff --git a/lib/hipe/test/basic_SUITE_data/basic_tail_rec.erl b/lib/hipe/test/basic_SUITE_data/basic_tail_rec.erl new file mode 100644 index 0000000000..0124f13df6 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_tail_rec.erl @@ -0,0 +1,39 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests that check that tail recursion optimization occurs. +%%%------------------------------------------------------------------- +-module(basic_tail_rec). + +-export([test/0]). +-export([app0/2]). %% used in an apply/3 call + +test() -> + ok = test_app_tail(), + ok. + +%%-------------------------------------------------------------------- +%% Written by Mikael Pettersson: check that apply is tail recursive. + +%% Increased the following quantity from 20 to 30 so that the test +%% remains valid even with the naive register allocator. - Kostis +-define(SIZE_INCREASE, 30). + +test_app_tail() -> + Inc = start(400), + %% io:format("Inc ~w\n", [Inc]), + case Inc > ?SIZE_INCREASE of + true -> + {error, "apply/3 is not tail recursive in native code"}; + false -> + ok + end. + +start(N) -> + app0(N, hipe_bifs:nstack_used_size()). + +app0(0, Size0) -> + hipe_bifs:nstack_used_size() - Size0; +app0(N, Size) -> + apply(?MODULE, app0, [N-1, Size]). diff --git a/lib/hipe/test/basic_SUITE_data/basic_tuples.erl b/lib/hipe/test/basic_SUITE_data/basic_tuples.erl new file mode 100644 index 0000000000..94c187e364 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_tuples.erl @@ -0,0 +1,177 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests that manipulate and pattern match against tuples. +%%%------------------------------------------------------------------- +-module(basic_tuples). + +-export([test/0]). + +test() -> + Num = 4711, + ok = test_match({}, {1}, {1,2}, {1,2,3}, {1,2,3,4}, {1,2,3,4,5}, + {1,2,3,4,5,6}, {1,2,3,4,5,6,7}, {1,2,3,4,5,6,7,8}), + ok = test_size({}, {a}, {{a},{b}}, {a,{b},c}), + ok = test_element({}, {a}, {a,b}, Num), + ok = test_setelement({}, {1}, {1,2}, 3, [1,2]), + ok = test_tuple_to_list({}, {a}, {a,b}, {a,b,c}, {a,b,c,d}, Num), + ok = test_list_to_tuple([], [a], [a,b], [a,b,c], [a,b,c,d], Num), + ok = test_tuple_with_case(), + ok = test_tuple_in_guard({a, b}, {a, b, c}), + ok. + +%%-------------------------------------------------------------------- +%% Tests matching of tuples + +test_match(T0, T1, T2, T3, T4, T5, T6, T7, T8) -> + {} = T0, + {1} = T1, + {1, 2} = T2, + {1, 2, 3} = T3, + {1, 2, 3, 4} = T4, + {1, 2, 3, 4, 5} = T5, + {1, 2, 3, 4, 5, 6} = T6, + T6 = {1, 2, 3, 4, 5, 6}, + T7 = {1, 2, 3, 4, 5, 6, 7}, + {1, 2, 3, 4, 5, 6, 7, 8} = T8, + ok. + +%%-------------------------------------------------------------------- +%% Tests the size/1 and tuple_size/1 BIFs. + +test_size(T0, T1, T2, T3) -> + [0, 1, 2, 3] = [size(T) || T <- [T0, T1, T2, T3]], + [0, 1, 2, 3] = [tuple_size(T) || T <- [T0, T1, T2, T3]], + ok. + +%%-------------------------------------------------------------------- +%% Tests element/2. + +test_element(T0, T1, T2, N) -> + a = element(1, T1), + a = element(1, T2), + %% indirect calls to element/2 + List = lists:seq(1, N), + Tuple = list_to_tuple(List), + ok = get_elements(List, Tuple, 1), + %% some cases that throw exceptions + {'EXIT', _} = (catch my_element(0, T2)), + {'EXIT', _} = (catch my_element(3, T2)), + {'EXIT', _} = (catch my_element(1, T0)), + {'EXIT', _} = (catch my_element(1, List)), + {'EXIT', _} = (catch my_element(1, N)), + {'EXIT', _} = (catch my_element(1.5, T2)), + ok. + +my_element(Pos, Term) -> + element(Pos, Term). + +get_elements([Element|Rest], Tuple, Pos) -> + Element = element(Pos, Tuple), + get_elements(Rest, Tuple, Pos + 1); +get_elements([], _Tuple, _Pos) -> + ok. + +%%-------------------------------------------------------------------- +%% Tests set_element/3. + +test_setelement(T0, T1, Pair, Three, L) -> + {x} = setelement(1, T1, x), + {x, 2} = setelement(1, Pair, x), + {1, x} = setelement(2, Pair, x), + %% indirect calls to setelement/3 + Tuple = list_to_tuple(lists:duplicate(2048, x)), + NewTuple = set_all_elements(Tuple, 1), + NewTuple = list_to_tuple(lists:seq(1+7, 2048+7)), + %% the following cases were rewritten to use the Three + %% variable in this weird way so as to silence the compiler + {'EXIT', _} = (catch setelement(Three - Three, Pair, x)), + {'EXIT', _} = (catch setelement(Three, Pair, x)), + {'EXIT', _} = (catch setelement(Three div Three, T0, x)), + {'EXIT', _} = (catch setelement(Three div Three, L, x)), + {'EXIT', _} = (catch setelement(Three / 2, Pair, x)), + ok. + +set_all_elements(Tuple, Pos) when Pos =< tuple_size(Tuple) -> + set_all_elements(setelement(Pos, Tuple, Pos+7), Pos+1); +set_all_elements(Tuple, Pos) when Pos > tuple_size(Tuple) -> + Tuple. + +%%-------------------------------------------------------------------- +%% Tests tuple_to_list/1. + +test_tuple_to_list(T0, T1, T2, T3, T4, Size) -> + [] = tuple_to_list(T0), + [a] = tuple_to_list(T1), + [a, b] = tuple_to_list(T2), + [a, b, c] = tuple_to_list(T3), + [a, b, c, d] = tuple_to_list(T4), + [a, b, c, d] = tuple_to_list(T4), + %% test a big tuple + List = lists:seq(1, Size), + Tuple = list_to_tuple(List), + Size = tuple_size(Tuple), + List = tuple_to_list(Tuple), + %% some cases that should result in errors + {'EXIT', _} = (catch my_tuple_to_list(element(2, T3))), + {'EXIT', _} = (catch my_tuple_to_list(Size)), + ok. + +my_tuple_to_list(X) -> + tuple_to_list(X). + +%%-------------------------------------------------------------------- +%% Tests list_to_tuple/1. + +test_list_to_tuple(L0, L1, L2, L3, L4, Size) -> + {} = list_to_tuple(L0), + {a} = list_to_tuple(L1), + {a, b} = list_to_tuple(L2), + {a, b, c} = list_to_tuple(L3), + {a, b, c, d} = list_to_tuple(L4), + {a, b, c, d, e} = list_to_tuple(L4++[e]), + %% test list_to_tuple with a big list + Tuple = list_to_tuple(lists:seq(1, Size)), + Size = tuple_size(Tuple), + %% some cases that should result in errors + {'EXIT', _} = (catch my_list_to_tuple({a,b})), + {'EXIT', _} = (catch my_list_to_tuple([hd(L1)|hd(L2)])), + ok. + +my_list_to_tuple(X) -> + list_to_tuple(X). + +%%-------------------------------------------------------------------- +%% Tests that a case nested inside a tuple is ok. +%% (This was known to crash earlier versions of BEAM.) + +test_tuple_with_case() -> + {reply, true} = tuple_with_case(), + ok. + +tuple_with_case() -> + %% The following comments apply to the BEAM compiler. + void(), % Reset var count. + {reply, % Compiler will choose {x,1} for tuple. + case void() of % Call will reset var count. + {'EXIT', Reason} -> % Case will return in {x,1} (first free), + {error, Reason}; % but the tuple will be build in {x,1}, + _ -> % so case value is lost and a circular + true % data element is built. + end}. + +void() -> ok. + +%%-------------------------------------------------------------------- +%% Test to build a tuple in a guard. + +test_tuple_in_guard(T2, T3) -> + %% T2 = {a, b}; T3 = {a, b, c} + ok = if T2 == {element(1, T3), element(2, T3)} -> ok; + true -> other + end, + ok = if T3 == {element(1, T3), element(2, T3), element(3, T3)} -> ok; + true -> other + end, + ok. diff --git a/lib/hipe/test/bs_SUITE_data/bs_add.erl b/lib/hipe/test/bs_SUITE_data/bs_add.erl index af5a3b2f23..4b92e6b413 100644 --- a/lib/hipe/test/bs_SUITE_data/bs_add.erl +++ b/lib/hipe/test/bs_SUITE_data/bs_add.erl @@ -2,7 +2,7 @@ %%------------------------------------------------------------------------- %% The guard in f/3 revealed a problem in the translation of the 'bs_add' %% BEAM instruction to Icode. The fail label was not properly translated. -%% Fixed 3/2/2011. +%% Fixed 3/2/2011. Then in 2015 we found another issue: g/2. Also fixed. %%------------------------------------------------------------------------- -module(bs_add). @@ -10,9 +10,17 @@ test() -> 42 = f(<<12345:16>>, 4711, <<42>>), + true = g(<<1:13>>, 3), %% was handled OK, but + false = g(<<>>, gurka), %% this one leaked badarith ok. f(Bin, A, B) when <<A:9, B:7/binary>> == Bin -> gazonk; f(Bin, _, _) when is_binary(Bin) -> 42. + +%% Complex way of testing (bit_size(Bin) + Len) rem 8 =:= 0 +g(Bin, Len) when is_binary(<<Bin/binary-unit:1, 123:Len>>) -> + true; +g(_, _) -> + false. diff --git a/lib/hipe/test/bs_SUITE_data/bs_construct.erl b/lib/hipe/test/bs_SUITE_data/bs_construct.erl index 37a54c1981..b9e7d93570 100644 --- a/lib/hipe/test/bs_SUITE_data/bs_construct.erl +++ b/lib/hipe/test/bs_SUITE_data/bs_construct.erl @@ -14,6 +14,11 @@ test() -> 16#10000008 = bit_size(large_bin(1, 2, 3, 4)), ok = bad_ones(), ok = zero_width(), + ok = not_used(), + ok = bad_append(), + ok = system_limit(), + ok = bad_floats(), + ok = huge_binaries(), ok. %%-------------------------------------------------------------------- @@ -142,3 +147,159 @@ zero_width() -> ok. id(X) -> X. + +%%-------------------------------------------------------------------- +%% Taken from bs_construct_SUITE. The test checks that constructed +%% binaries that are not used would still give a `badarg' exception. +%% Problem was that in native code one of them gave `badarith'. + +not_used() -> + ok = not_used1(3, <<"dum">>), + {'EXIT',{badarg,_}} = (catch not_used1(42, "dum_string")), + {'EXIT',{badarg,_}} = (catch not_used2(666, -2)), + {'EXIT',{badarg,_}} = (catch not_used2(666, "bad_size")), % this one + {'EXIT',{badarg,_}} = (catch not_used3(666)), + ok. + +not_used1(I, BinString) -> + <<I:32,BinString/binary>>, + ok. + +not_used2(I, Sz) -> + <<I:Sz>>, + ok. + +not_used3(I) -> + <<I:(-8)>>, + ok. + +%%-------------------------------------------------------------------- +%% Taken from bs_construct_SUITE. + +bad_append() -> + do_bad_append(<<127:1>>, fun append_unit_3/1), + do_bad_append(<<127:2>>, fun append_unit_3/1), + do_bad_append(<<127:17>>, fun append_unit_3/1), + + do_bad_append(<<127:3>>, fun append_unit_4/1), + do_bad_append(<<127:5>>, fun append_unit_4/1), + do_bad_append(<<127:7>>, fun append_unit_4/1), + do_bad_append(<<127:199>>, fun append_unit_4/1), + + do_bad_append(<<127:7>>, fun append_unit_8/1), + do_bad_append(<<127:9>>, fun append_unit_8/1), + + do_bad_append(<<0:8>>, fun append_unit_16/1), + do_bad_append(<<0:15>>, fun append_unit_16/1), + do_bad_append(<<0:17>>, fun append_unit_16/1), + ok. + +do_bad_append(Bin0, Appender) -> + {'EXIT',{badarg,_}} = (catch Appender(Bin0)), + + Bin1 = id(<<0:3,Bin0/bitstring>>), + <<_:3,Bin2/bitstring>> = Bin1, + {'EXIT',{badarg,_}} = (catch Appender(Bin2)), + + %% Create a writable binary. + Empty = id(<<>>), + Bin3 = <<Empty/bitstring,Bin0/bitstring>>, + {'EXIT',{badarg,_}} = (catch Appender(Bin3)), + ok. + +append_unit_3(Bin) -> + <<Bin/binary-unit:3,0:1>>. + +append_unit_4(Bin) -> + <<Bin/binary-unit:4,0:1>>. + +append_unit_8(Bin) -> + <<Bin/binary,0:1>>. + +append_unit_16(Bin) -> + <<Bin/binary-unit:16,0:1>>. + +%%-------------------------------------------------------------------- +%% Taken from bs_construct_SUITE. + +system_limit() -> + WordSize = erlang:system_info(wordsize), + BitsPerWord = WordSize * 8, + {'EXIT',{system_limit,_}} = + (catch <<0:(id(0)),42:(id(1 bsl BitsPerWord))>>), + {'EXIT',{system_limit,_}} = + (catch <<42:(id(1 bsl BitsPerWord)),0:(id(0))>>), + {'EXIT',{system_limit,_}} = + (catch <<(id(<<>>))/binary,0:(id(1 bsl 100))>>), + + %% Would fail to load. + {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 67)>>), + {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 64)+1)>>), + case WordSize of + 4 -> + system_limit_32(); + 8 -> + ok + end. + +system_limit_32() -> + {'EXIT',{badarg,_}} = (catch <<42:(-1)>>), + {'EXIT',{badarg,_}} = (catch <<42:(id(-1))>>), + {'EXIT',{badarg,_}} = (catch <<42:(id(-389739873536870912))/unit:8>>), + {'EXIT',{system_limit,_}} = (catch <<42:536870912/unit:8>>), + {'EXIT',{system_limit,_}} = (catch <<42:(id(536870912))/unit:8>>), + {'EXIT',{system_limit,_}} = (catch <<0:(id(8)),42:536870912/unit:8>>), + {'EXIT',{system_limit,_}} = (catch <<0:(id(8)),42:(id(536870912))/unit:8>>), + + %% The size would be silently truncated, resulting in a crash. + {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 35)>>), + {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 32)+1)>>), + + %% Would fail to load. + {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 43)>>), + {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 40)+1)>>), + ok. + +%%-------------------------------------------------------------------- + +bad_floats() -> + WordSize = erlang:system_info(wordsize), + BitsPerWord = WordSize * 8, + {'EXIT',{badarg,_}} = (catch <<3.14:(id(33))/float>>), + {'EXIT',{badarg,_}} = (catch <<3.14:(id(64 bor 32))/float>>), + {'EXIT',{badarg,_}} = (catch <<3.14:(id((1 bsl 28) bor 32))/float>>), + {'EXIT',{system_limit,_}} = (catch <<3.14:(id(1 bsl BitsPerWord))/float>>), + ok. + +%%-------------------------------------------------------------------- +%% A bug in the implementation of binaries compared sizes in bits with sizes in +%% bytes, causing <<0:(id((1 bsl 31)-1))>> to fail to construct with +%% 'system_limit'. +%% <<0:(id((1 bsl 32)-1))>> was succeeding because the comparison was +%% (incorrectly) signed. + +huge_binaries() -> + AlmostIllegal = id(<<0:(id((1 bsl 32)-8))>>), + case erlang:system_info(wordsize) of + 4 -> huge_binaries_32(AlmostIllegal); + 8 -> ok + end, + garbage_collect(), + id(<<0:(id((1 bsl 31)-1))>>), + id(<<0:(id((1 bsl 30)-1))>>), + garbage_collect(), + ok. + +huge_binaries_32(AlmostIllegal) -> + %% Attempt construction of too large binary using bs_init/1 (which takes the + %% number of bytes as an argument, which should be compared to the maximum + %% size in bytes). + {'EXIT',{system_limit,_}} = (catch <<0:32,AlmostIllegal/binary>>), + %% Attempt construction of too large binary using bs_init/1 with a size in + %% bytes that has the msb set (and would be negative if it was signed). + {'EXIT',{system_limit,_}} = + (catch <<0:8, AlmostIllegal/binary, AlmostIllegal/binary, + AlmostIllegal/binary, AlmostIllegal/binary, + AlmostIllegal/binary, AlmostIllegal/binary, + AlmostIllegal/binary, AlmostIllegal/binary>>), + ok. diff --git a/lib/hipe/test/bs_SUITE_data/bs_split.erl b/lib/hipe/test/bs_SUITE_data/bs_split.erl index 2e52308a77..617543f789 100644 --- a/lib/hipe/test/bs_SUITE_data/bs_split.erl +++ b/lib/hipe/test/bs_SUITE_data/bs_split.erl @@ -26,13 +26,13 @@ bs1(L, B, Pos, Sz1, Sz2) -> <<B1:Sz1/binary, B2:Sz2/binary>> = B, bs2(L, B, Pos, B1, B2). -bs2(L, B, Pos, B1, B2)-> +bs2(L, B, Pos, B1, B2) -> B1 = list_to_binary(lists:sublist(L, 1, Pos)), bs3(L, B, Pos, B2). bs3(L, B, Pos, B2) -> B2 = list_to_binary(lists:nthtail(Pos, L)), - byte_split(L, B, Pos-1). + byte_split(L, B, Pos - 1). %%-------------------------------------------------------------------- @@ -56,14 +56,14 @@ bit_split_binary2(_Action, _Bin, [], _Bef) -> ok. bit_split_binary3(Action, Bin, List, Bef, Aft) when Bef =< Aft -> Action(Bin, List, Bef, (Aft-Bef) div 8 * 8), - bit_split_binary3(Action, Bin, List, Bef, Aft-8); + bit_split_binary3(Action, Bin, List, Bef, Aft - 8); bit_split_binary3(_, _, _, _, _) -> ok. make_bin_from_list(_List, 0) -> mkbin([]); make_bin_from_list(List, N) -> list_to_binary([make_int(List, 8, 0), - make_bin_from_list(lists:nthtail(8, List), N-8)]). + make_bin_from_list(lists:nthtail(8, List), N - 8)]). make_int(_List, 0, Acc) -> Acc; make_int([H|T], N, Acc) -> make_int(T, N-1, Acc bsl 1 bor H). @@ -101,5 +101,5 @@ z_split(B, N) -> <<_:N/binary>> -> [B]; _ -> - z_split(B, N+1) + z_split(B, N + 1) end. diff --git a/lib/hipe/test/bs_SUITE_data/bs_utf.erl b/lib/hipe/test/bs_SUITE_data/bs_utf.erl index f50ae08964..368ad0cd20 100644 --- a/lib/hipe/test/bs_SUITE_data/bs_utf.erl +++ b/lib/hipe/test/bs_SUITE_data/bs_utf.erl @@ -1,18 +1,356 @@ %% -*- erlang-indent-level: 2 -*- %%------------------------------------------------------------------- -%% Purpose: test support for UTF datatypes in binaries - INCOMPLETE +%% Purpose: test support for UTF datatypes in binaries +%% +%% Most of it taken from emulator/test/bs_utf_SUITE.erl %%------------------------------------------------------------------- -module(bs_utf). -export([test/0]). +-include_lib("common_test/include/ct.hrl"). + test() -> + ok = utf8_cm65(), + ok = utf8_roundtrip(), + ok = utf16_roundtrip(), + ok = utf32_roundtrip(), + %% The following were problematic for the LLVM backend + ok = utf8_illegal_sequences(), + ok = utf16_illegal_sequences(), + ok = utf32_illegal_sequences(), + ok. + +%%------------------------------------------------------------------- +%% A test with construction and matching + +utf8_cm65() -> <<65>> = b65utf8(), ok = m(<<65>>). +b65utf8() -> + <<65/utf8>>. + m(<<65/utf8>>) -> ok. -b65utf8() -> - <<65/utf8>>. +%%------------------------------------------------------------------- + +utf8_roundtrip() -> + ok = utf8_roundtrip(0, 16#D7FF), + ok = utf8_roundtrip(16#E000, 16#10FFFF), + ok. + +utf8_roundtrip(First, Last) when First =< Last -> + Bin = int_to_utf8(First), + Bin = id(<<First/utf8>>), + Bin = id(<<(id(<<>>))/binary,First/utf8>>), + Unaligned = id(<<3:2,First/utf8>>), + <<_:2,Bin/binary>> = Unaligned, + <<First/utf8>> = Bin, + <<First/utf8>> = make_unaligned(Bin), + utf8_roundtrip(First+1, Last); +utf8_roundtrip(_, _) -> + ok. + +%%------------------------------------------------------------------- + +utf16_roundtrip() -> + Big = fun utf16_big_roundtrip/1, + Little = fun utf16_little_roundtrip/1, + PidRefs = [spawn_monitor(fun() -> do_utf16_roundtrip(Fun) end) || + Fun <- [Big,Little]], + [receive {'DOWN', Ref, process, Pid, Reason} -> normal=Reason end || + {Pid, Ref} <- PidRefs], + ok. + +do_utf16_roundtrip(Fun) -> + do_utf16_roundtrip(0, 16#D7FF, Fun), + do_utf16_roundtrip(16#E000, 16#10FFFF, Fun). + +do_utf16_roundtrip(First, Last, Fun) when First =< Last -> + Fun(First), + do_utf16_roundtrip(First+1, Last, Fun); +do_utf16_roundtrip(_, _, _) -> ok. + +utf16_big_roundtrip(Char) -> + Bin = id(<<Char/utf16>>), + Bin = id(<<(id(<<>>))/binary,Char/utf16>>), + Unaligned = id(<<3:2,Char/utf16>>), + <<_:2,Bin/binary>> = Unaligned, + <<Char/utf16>> = Bin, + <<Char/utf16>> = make_unaligned(Bin), + ok. + +utf16_little_roundtrip(Char) -> + Bin = id(<<Char/little-utf16>>), + Bin = id(<<(id(<<>>))/binary,Char/little-utf16>>), + Unaligned = id(<<3:2,Char/little-utf16>>), + <<_:2,Bin/binary>> = Unaligned, + <<Char/little-utf16>> = Bin, + <<Char/little-utf16>> = make_unaligned(Bin), + ok. + +%%------------------------------------------------------------------- + +utf32_roundtrip() -> + Big = fun utf32_big_roundtrip/1, + Little = fun utf32_little_roundtrip/1, + PidRefs = [spawn_monitor(fun() -> do_utf32_roundtrip(Fun) end) || + Fun <- [Big,Little]], + [receive {'DOWN', Ref, process, Pid, Reason} -> normal=Reason end || + {Pid, Ref} <- PidRefs], + ok. + +do_utf32_roundtrip(Fun) -> + do_utf32_roundtrip(0, 16#D7FF, Fun), + do_utf32_roundtrip(16#E000, 16#10FFFF, Fun). + +do_utf32_roundtrip(First, Last, Fun) when First =< Last -> + Fun(First), + do_utf32_roundtrip(First+1, Last, Fun); +do_utf32_roundtrip(_, _, _) -> ok. + +utf32_big_roundtrip(Char) -> + Bin = id(<<Char/utf32>>), + Bin = id(<<(id(<<>>))/binary,Char/utf32>>), + Unaligned = id(<<3:2,Char/utf32>>), + <<_:2,Bin/binary>> = Unaligned, + <<Char/utf32>> = Bin, + <<Char/utf32>> = make_unaligned(Bin), + ok. + +utf32_little_roundtrip(Char) -> + Bin = id(<<Char/little-utf32>>), + Bin = id(<<(id(<<>>))/binary,Char/little-utf32>>), + Unaligned = id(<<3:2,Char/little-utf32>>), + <<_:2,Bin/binary>> = Unaligned, + <<Char/little-utf32>> = Bin, + <<Char/little-utf32>> = make_unaligned(Bin), + ok. + +%%------------------------------------------------------------------- + +utf8_illegal_sequences() -> + fail_range(16#10FFFF+1, 16#10FFFF+512), % Too large. + fail_range(16#D800, 16#DFFF), % Reserved for UTF-16. + + %% Illegal first character. + [fail(<<I,16#8F,16#8F,16#8F>>) || I <- lists:seq(16#80, 16#BF)], + + %% Short sequences. + short_sequences(16#80, 16#10FFFF), + + %% Overlong sequences. (Using more bytes than necessary + %% is not allowed.) + overlong(0, 127, 2), + overlong(128, 16#7FF, 3), + overlong(16#800, 16#FFFF, 4), + ok. + +fail_range(Char, End) when Char =< End -> + {'EXIT', _} = (catch <<Char/utf8>>), + Bin = int_to_utf8(Char), + fail(Bin), + fail_range(Char+1, End); +fail_range(_, _) -> ok. + +short_sequences(Char, End) -> + Step = (End - Char) div erlang:system_info(schedulers) + 1, + PidRefs = short_sequences_1(Char, Step, End), + [receive {'DOWN', Ref, process, Pid, Reason} -> normal=Reason end || + {Pid, Ref} <- PidRefs], + ok. + +short_sequences_1(Char, Step, End) when Char =< End -> + CharEnd = lists:min([Char+Step-1,End]), + [spawn_monitor(fun() -> + %% io:format("~p - ~p\n", [Char, CharEnd]), + do_short_sequences(Char, CharEnd) + end)|short_sequences_1(Char+Step, Step, End)]; +short_sequences_1(_, _, _) -> []. + +do_short_sequences(Char, End) when Char =< End -> + short_sequence(Char), + do_short_sequences(Char+1, End); +do_short_sequences(_, _) -> ok. + +short_sequence(I) -> + case int_to_utf8(I) of + <<S0:3/binary,_:8>> -> + <<S1:2/binary,R1:8>> = S0, + <<S2:1/binary,_:8>> = S1, + fail(S0), + fail(S1), + fail(S2), + fail(<<S2/binary,16#7F,R1,R1>>), + fail(<<S1/binary,16#7F,R1>>), + fail(<<S0/binary,16#7F>>); + <<S0:2/binary,_:8>> -> + <<S1:1/binary,R1:8>> = S0, + fail(S0), + fail(S1), + fail(<<S0/binary,16#7F>>), + fail(<<S1/binary,16#7F>>), + fail(<<S1/binary,16#7F,R1>>); + <<S:1/binary,_:8>> -> + fail(S), + fail(<<S/binary,16#7F>>) + end. + +overlong(Char, Last, NumBytes) when Char =< Last -> + overlong(Char, NumBytes), + overlong(Char+1, Last, NumBytes); +overlong(_, _, _) -> ok. + +overlong(Char, NumBytes) when NumBytes < 5 -> + case int_to_utf8(Char, NumBytes) of + <<Char/utf8>>=Bin -> + ?t:fail({illegal_encoding_accepted,Bin,Char}); + <<OtherChar/utf8>>=Bin -> + ?t:fail({illegal_encoding_accepted,Bin,Char,OtherChar}); + _ -> ok + end, + overlong(Char, NumBytes+1); +overlong(_, _) -> ok. + +fail(Bin) -> + fail_1(Bin), + fail_1(make_unaligned(Bin)). + +fail_1(<<Char/utf8>> = Bin) -> + ?t:fail({illegal_encoding_accepted, Bin, Char}); +fail_1(_) -> ok. + +%%------------------------------------------------------------------- + +utf16_illegal_sequences() -> + utf16_fail_range(16#10FFFF+1, 16#10FFFF+512), % Too large. + utf16_fail_range(16#D800, 16#DFFF), % Reserved for UTF-16. + lonely_hi_surrogate(16#D800, 16#DFFF), + leading_lo_surrogate(16#DC00, 16#DFFF), + ok. + +utf16_fail_range(Char, End) when Char =< End -> + {'EXIT', _} = (catch <<Char/big-utf16>>), + {'EXIT', _} = (catch <<Char/little-utf16>>), + utf16_fail_range(Char+1, End); +utf16_fail_range(_, _) -> ok. + +lonely_hi_surrogate(Char, End) when Char =< End -> + BinBig = <<Char:16/big>>, + BinLittle = <<Char:16/little>>, + case {BinBig,BinLittle} of + {<<Bad/big-utf16>>,_} -> + ?t:fail({lonely_hi_surrogate_accepted,Bad}); + {_,<<Bad/little-utf16>>} -> + ?t:fail({lonely_hi_surrogate_accepted,Bad}); + {_,_} -> + ok + end, + lonely_hi_surrogate(Char+1, End); +lonely_hi_surrogate(_, _) -> ok. + +leading_lo_surrogate(Char, End) when Char =< End -> + leading_lo_surrogate(Char, 16#D800, 16#DFFF), + leading_lo_surrogate(Char+1, End); +leading_lo_surrogate(_, _) -> ok. + +leading_lo_surrogate(HiSurr, LoSurr, End) when LoSurr =< End -> + BinBig = <<HiSurr:16/big,LoSurr:16/big>>, + BinLittle = <<HiSurr:16/little,LoSurr:16/little>>, + case {BinBig,BinLittle} of + {<<Bad/big-utf16,_/bits>>,_} -> + ?t:fail({leading_lo_surrogate_accepted,Bad}); + {_,<<Bad/little-utf16,_/bits>>} -> + ?t:fail({leading_lo_surrogate_accepted,Bad}); + {_,_} -> + ok + end, + leading_lo_surrogate(HiSurr, LoSurr+1, End); +leading_lo_surrogate(_, _, _) -> ok. + +%%------------------------------------------------------------------- + +utf32_illegal_sequences() -> + utf32_fail_range(16#10FFFF+1, 16#10FFFF+512), % Too large. + utf32_fail_range(16#D800, 16#DFFF), % Reserved for UTF-16. + utf32_fail_range(-100, -1), + ok. + +utf32_fail_range(Char, End) when Char =< End -> + {'EXIT', _} = (catch <<Char/big-utf32>>), + {'EXIT', _} = (catch <<Char/little-utf32>>), + case {<<Char:32>>,<<Char:32/little>>} of + {<<Unexpected/utf32>>,_} -> + ?t:fail(Unexpected); + {_,<<Unexpected/little-utf32>>} -> + ?t:fail(Unexpected); + {_,_} -> ok + end, + utf32_fail_range(Char+1, End); +utf32_fail_range(_, _) -> ok. + +%%------------------------------------------------------------------- +%% This function intentionally allows construction of UTF-8 sequence +%% in illegal ranges. + +int_to_utf8(I) when I =< 16#7F -> + <<I>>; +int_to_utf8(I) when I =< 16#7FF -> + B2 = I, + B1 = (I bsr 6), + <<1:1,1:1,0:1,B1:5,1:1,0:1,B2:6>>; +int_to_utf8(I) when I =< 16#FFFF -> + B3 = I, + B2 = (I bsr 6), + B1 = (I bsr 12), + <<1:1,1:1,1:1,0:1,B1:4,1:1,0:1,B2:6,1:1,0:1,B3:6>>; +int_to_utf8(I) when I =< 16#3FFFFF -> + B4 = I, + B3 = (I bsr 6), + B2 = (I bsr 12), + B1 = (I bsr 18), + <<1:1,1:1,1:1,1:1,0:1,B1:3,1:1,0:1,B2:6,1:1,0:1,B3:6,1:1,0:1,B4:6>>; +int_to_utf8(I) when I =< 16#3FFFFFF -> + B5 = I, + B4 = (I bsr 6), + B3 = (I bsr 12), + B2 = (I bsr 18), + B1 = (I bsr 24), + <<1:1,1:1,1:1,1:1,1:1,0:1,B1:2,1:1,0:1,B2:6,1:1,0:1,B3:6,1:1,0:1,B4:6, + 1:1,0:1,B5:6>>. + +%% int_to_utf8(I, NumberOfBytes) -> Binary. +%% This function can be used to construct overlong sequences. +int_to_utf8(I, 1) -> + <<I>>; +int_to_utf8(I, 2) -> + B2 = I, + B1 = (I bsr 6), + <<1:1,1:1,0:1,B1:5,1:1,0:1,B2:6>>; +int_to_utf8(I, 3) -> + B3 = I, + B2 = (I bsr 6), + B1 = (I bsr 12), + <<1:1,1:1,1:1,0:1,B1:4,1:1,0:1,B2:6,1:1,0:1,B3:6>>; +int_to_utf8(I, 4) -> + B4 = I, + B3 = (I bsr 6), + B2 = (I bsr 12), + B1 = (I bsr 18), + <<1:1,1:1,1:1,1:1,0:1,B1:3,1:1,0:1,B2:6,1:1,0:1,B3:6,1:1,0:1,B4:6>>. + +%%------------------------------------------------------------------- + +make_unaligned(Bin0) when is_binary(Bin0) -> + Bin1 = <<0:3,Bin0/binary,31:5>>, + Sz = byte_size(Bin0), + <<0:3,Bin:Sz/binary,31:5>> = id(Bin1), + Bin. + +%%------------------------------------------------------------------- +%% Just to prevent compiler optimizations + +id(X) -> X. diff --git a/lib/hipe/test/hipe_testsuite_driver.erl b/lib/hipe/test/hipe_testsuite_driver.erl index 5f05a716bc..9f5d7421b4 100644 --- a/lib/hipe/test/hipe_testsuite_driver.erl +++ b/lib/hipe/test/hipe_testsuite_driver.erl @@ -176,7 +176,8 @@ run(TestCase, Dir, _OutDir) -> HiPEOpts = try TestCase:hipe_options() catch error:undef -> [] end, {ok, TestCase} = hipe:c(TestCase, HiPEOpts), ok = TestCase:test(), - case is_llvm_opt_available() of + ToLLVM = try TestCase:to_llvm() catch error:undef -> true end, + case ToLLVM andalso hipe:llvm_support_available() of true -> {ok, TestCase} = hipe:c(TestCase, [to_llvm|HiPEOpts]), ok = TestCase:test(); @@ -186,16 +187,3 @@ run(TestCase, Dir, _OutDir) -> %% lists:foreach(fun (DF) -> ok end, % = file:delete(DF) end, %% [filename:join(OutDir, D) || D <- DataFiles]) %% end. - - -%% This function, which is supposed to check whether the right LLVM -%% infrastructure is available, should be probably written in a better -%% and more portable way and moved to the hipe application. - -is_llvm_opt_available() -> - OptStr = os:cmd("opt -version"), - SubStr = "LLVM version ", N = length(SubStr), - case string:str(OptStr, SubStr) of - 0 -> false; - S -> P = S + N, string:sub_string(OptStr, P, P + 2) >= "3.4" - end. diff --git a/lib/hipe/test/sanity_SUITE_data/sanity_comp_timeout.erl b/lib/hipe/test/sanity_SUITE_data/sanity_comp_timeout.erl new file mode 100644 index 0000000000..9f0830574f --- /dev/null +++ b/lib/hipe/test/sanity_SUITE_data/sanity_comp_timeout.erl @@ -0,0 +1,28 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%---------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Tests that when the native code compilation times out or gets killed +%%% for some other reason, the parent process does not also get killed. +%%% +%%% Problem discovered by Bjorn G. on 1/12/2003 and fixed by Kostis. +%%%---------------------------------------------------------------------- + +-module(sanity_comp_timeout). + +-export([test/0, to_llvm/0]). + +test() -> + ok = write_dummy_mod(), + error_logger:tty(false), % disable printouts of error reports + Self = self(), % get the parent process + c:c(dummy_mod, [native, {hipe, [{timeout, 1}]}]), % This will kill the process + Self = self(), % make sure the parent process stays the same + ok. + +to_llvm() -> false. + +write_dummy_mod() -> + Prog = <<"-module(dummy_mod).\n-export([test/0]).\ntest() -> ok.\n">>, + ok = file:write_file("dummy_mod.erl", Prog). + diff --git a/lib/hipe/test/sanity_SUITE_data/sanity_no_zombies.erl b/lib/hipe/test/sanity_SUITE_data/sanity_no_zombies.erl new file mode 100644 index 0000000000..87e746042e --- /dev/null +++ b/lib/hipe/test/sanity_SUITE_data/sanity_no_zombies.erl @@ -0,0 +1,21 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%---------------------------------------------------------------------- +%%% Author: Per Gustafsson +%%% +%%% Checks that HiPE's concurrent compilation does not leave any zombie +%%% processes around after compilation has finished. +%%% +%%% This was a bug reported on erlang-bugs (Oct 25, 2007). +%%%---------------------------------------------------------------------- + +-module(sanity_no_zombies). + +-export([test/0, to_llvm/0]). + +test() -> + L = length(processes()), + hipe:c(?MODULE, [concurrent_comp]), % force concurrent compilation + L = length(processes()), + ok. + +to_llvm() -> false. diff --git a/lib/ic/test/Makefile b/lib/ic/test/Makefile index 576ffc4eff..93cbaf4dfe 100644 --- a/lib/ic/test/Makefile +++ b/lib/ic/test/Makefile @@ -209,10 +209,8 @@ ERL_LOCAL_FLAGS += -pa $(ERL_TOP)/lib/orber/ebin -pa $(ERL_TOP)/lib/ic/ebin ERL_COMPILE_FLAGS += \ $(ERL_LOCAL_FLAGS) \ - -pa $(ERL_TOP)/lib/test_server/ebin \ -pa $(ERL_TOP)/lib/orber/ebin \ - -I$(ERL_TOP)/lib/orber \ - -I$(ERL_TOP)/lib/test_server/include + -I$(ERL_TOP)/lib/orber # ---------------------------------------------------- # Targets diff --git a/lib/ic/test/ic_SUITE.erl b/lib/ic/test/ic_SUITE.erl index bca75b8349..c9fbf49a55 100644 --- a/lib/ic/test/ic_SUITE.erl +++ b/lib/ic/test/ic_SUITE.erl @@ -23,7 +23,7 @@ %%%---------------------------------------------------------------------- -module(ic_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). diff --git a/lib/ic/test/ic_be_SUITE.erl b/lib/ic/test/ic_be_SUITE.erl index 42c30fc86e..49dd9953cb 100644 --- a/lib/ic/test/ic_be_SUITE.erl +++ b/lib/ic/test/ic_be_SUITE.erl @@ -23,7 +23,7 @@ %%%---------------------------------------------------------------------- -module(ic_be_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/lib/ic/test/ic_pp_SUITE.erl b/lib/ic/test/ic_pp_SUITE.erl index ab22d532a1..e85ce788e3 100644 --- a/lib/ic/test/ic_pp_SUITE.erl +++ b/lib/ic/test/ic_pp_SUITE.erl @@ -23,7 +23,7 @@ %%---------------------------------------------------------------------- -module(ic_pp_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). diff --git a/lib/ic/test/ic_pragma_SUITE.erl b/lib/ic/test/ic_pragma_SUITE.erl index e0ab43e178..c6e23a1f8c 100644 --- a/lib/ic/test/ic_pragma_SUITE.erl +++ b/lib/ic/test/ic_pragma_SUITE.erl @@ -28,7 +28,7 @@ %%----------------------------------------------------------------- -module(ic_pragma_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). %%----------------------------------------------------------------- %% External exports diff --git a/lib/ic/test/ic_register_SUITE.erl b/lib/ic/test/ic_register_SUITE.erl index e402692940..86d89e72d5 100644 --- a/lib/ic/test/ic_register_SUITE.erl +++ b/lib/ic/test/ic_register_SUITE.erl @@ -27,7 +27,7 @@ %%----------------------------------------------------------------- -module(ic_register_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). %%----------------------------------------------------------------- %% External exports diff --git a/lib/ic/test/java_client_erl_server_SUITE.erl b/lib/ic/test/java_client_erl_server_SUITE.erl index e95b3d5026..a670c5546e 100644 --- a/lib/ic/test/java_client_erl_server_SUITE.erl +++ b/lib/ic/test/java_client_erl_server_SUITE.erl @@ -23,7 +23,7 @@ %%%---------------------------------------------------------------------- -module(java_client_erl_server_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml index c98ec1a9dc..44e1ea9abe 100644 --- a/lib/inets/doc/src/notes.xml +++ b/lib/inets/doc/src/notes.xml @@ -33,7 +33,23 @@ <file>notes.xml</file> </header> - <section><title>Inets 6.1</title> + <section><title>Inets 6.1.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + mod_alias now traverses all aliases picking the longest + match and not the first match.</p> + <p> + Own Id: OTP-13248</p> + </item> + </list> + </section> + +</section> + +<section><title>Inets 6.1</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/inets/src/http_client/httpc.erl b/lib/inets/src/http_client/httpc.erl index e4a6f8f748..85663b5ded 100644 --- a/lib/inets/src/http_client/httpc.erl +++ b/lib/inets/src/http_client/httpc.erl @@ -101,7 +101,8 @@ request(Url, Profile) -> %% {ok, {StatusLine, Headers, Body}} | {ok, {Status, Body}} | %% {ok, RequestId} | {error,Reason} | {ok, {saved_as, FilePath} %% -%% Method - atom() = head | get | put | post | trace | options| delete +%% Method - atom() = head | get | put | patch | post | trace | +%% options | delete %% Request - {Url, Headers} | {Url, Headers, ContentType, Body} %% Url - string() %% HTTPOptions - [HttpOption] @@ -176,8 +177,8 @@ request(Method, request(Method, {Url, Headers, ContentType, Body}, HTTPOptions, Options, Profile) - when ((Method =:= post) orelse (Method =:= put) orelse (Method =:= delete)) andalso - (is_atom(Profile) orelse is_pid(Profile)) -> + when ((Method =:= post) orelse (Method =:= patch) orelse (Method =:= put) orelse + (Method =:= delete)) andalso (is_atom(Profile) orelse is_pid(Profile)) -> ?hcrt("request", [{method, Method}, {url, Url}, {headers, Headers}, diff --git a/lib/inets/src/http_client/httpc_request.erl b/lib/inets/src/http_client/httpc_request.erl index e4451401f4..af4c3f75f2 100644 --- a/lib/inets/src/http_client/httpc_request.erl +++ b/lib/inets/src/http_client/httpc_request.erl @@ -187,7 +187,8 @@ is_client_closing(Headers) -> %%% Internal functions %%%======================================================================== post_data(Method, Headers, {ContentType, Body}, HeadersAsIs) - when (Method =:= post) orelse (Method =:= put) -> + when (Method =:= post) orelse (Method =:= put) + orelse (Method =:= patch) -> NewBody = case Headers#http_request_h.expect of "100-continue" -> ""; diff --git a/lib/inets/src/http_lib/http_uri.erl b/lib/inets/src/http_lib/http_uri.erl index 6fe8c1776d..9940136f5a 100644 --- a/lib/inets/src/http_lib/http_uri.erl +++ b/lib/inets/src/http_lib/http_uri.erl @@ -196,10 +196,10 @@ parse_host_port(_Scheme, DefaultPort, HostPort, _Opts) -> {Host, int_port(Port)}. split_uri(UriPart, SplitChar, NoMatchResult, SkipLeft, SkipRight) -> - case inets_regexp:first_match(UriPart, SplitChar) of - {match, Match, _} -> - {string:substr(UriPart, 1, Match - SkipLeft), - string:substr(UriPart, Match + SkipRight, length(UriPart))}; + case re:run(UriPart, SplitChar, [{capture, first}]) of + {match, [{Match, _}]} -> + {string:substr(UriPart, 1, Match + 1 - SkipLeft), + string:substr(UriPart, Match + 1 + SkipRight, length(UriPart))}; nomatch -> NoMatchResult end. diff --git a/lib/inets/src/http_server/httpd.erl b/lib/inets/src/http_server/httpd.erl index cf02c0e072..e6377b4882 100644 --- a/lib/inets/src/http_server/httpd.erl +++ b/lib/inets/src/http_server/httpd.erl @@ -43,7 +43,7 @@ %%%======================================================================== parse_query(String) -> - {ok, SplitString} = inets_regexp:split(String,"[&;]"), + SplitString = re:split(String,"[&;]", [{return, list}]), foreach(SplitString). reload_config(Config = [Value| _], Mode) when is_tuple(Value) -> @@ -239,14 +239,14 @@ unblock(Addr, Port, Profile) when is_integer(Port) -> foreach([]) -> []; foreach([KeyValue|Rest]) -> - {ok, Plus2Space, _} = inets_regexp:gsub(KeyValue,"[\+]"," "), - case inets_regexp:split(Plus2Space,"=") of - {ok,[Key|Value]} -> - [{http_uri:decode(Key), - http_uri:decode(lists:flatten(Value))}|foreach(Rest)]; - {ok,_} -> - foreach(Rest) - end. + 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) -> diff --git a/lib/inets/src/http_server/httpd_conf.erl b/lib/inets/src/http_server/httpd_conf.erl index 62e8a95b19..a7783bc1e9 100644 --- a/lib/inets/src/http_server/httpd_conf.erl +++ b/lib/inets/src/http_server/httpd_conf.erl @@ -232,7 +232,7 @@ load("KeepAliveTimeout " ++ Timeout, []) -> end; load("Modules " ++ Modules, []) -> - {ok, ModuleList} = inets_regexp:split(Modules," "), + ModuleList = re:split(Modules," ", [{return, list}]), {ok, [], {modules,[list_to_atom(X) || X <- ModuleList]}}; load("ServerAdmin " ++ ServerAdmin, []) -> @@ -879,7 +879,7 @@ bootstrap([]) -> bootstrap([Line|Config]) -> case Line of "Modules " ++ Modules -> - {ok, ModuleList} = inets_regexp:split(Modules," "), + ModuleList = re:split(Modules," ", [{return, list}]), TheMods = [list_to_atom(X) || X <- ModuleList], case verify_modules(TheMods) of ok -> @@ -1004,7 +1004,7 @@ read_config_file(Stream, SoFar) -> %% Ignore commented lines for efficiency later .. read_config_file(Stream, SoFar); Line -> - {ok, NewLine, _}=inets_regexp:sub(clean(Line),"[\t\r\f ]"," "), + NewLine = re:replace(clean(Line),"[\t\r\f ]"," ", [{return,list}]), case NewLine of [] -> %% Also ignore empty lines .. @@ -1031,12 +1031,12 @@ parse_mime_types(Stream, MimeTypesList, "") -> parse_mime_types(Stream, MimeTypesList, [$#|_]) -> parse_mime_types(Stream, MimeTypesList); parse_mime_types(Stream, MimeTypesList, Line) -> - case inets_regexp:split(Line, " ") of - {ok, [NewMimeType|Suffixes]} -> + case re:split(Line, " ", [{return, list}]) of + [NewMimeType|Suffixes] -> parse_mime_types(Stream, lists:append(suffixes(NewMimeType,Suffixes), MimeTypesList)); - {ok, _} -> + _ -> {error, ?NICE(Line)} end. @@ -1207,9 +1207,8 @@ error_report(Where,M,F,Error) -> error_logger:error_report([{?MODULE, Where}, {apply, {M, F, []}}, Error]). white_space_clean(String) -> - {ok,CleanedString,_} = - inets_regexp:gsub(String, "^[ \t\n\r\f]*|[ \t\n\r\f]*\$",""), - CleanedString. + re:replace(String, "^[ \t\n\r\f]*|[ \t\n\r\f]*\$","", + [{return,list}, global]). %%%========================================================================= @@ -1246,22 +1245,23 @@ is_file(_Type,_Access,FileInfo,_File) -> {error,FileInfo}. make_integer(String) -> - case inets_regexp:match(string:strip(String),"[0-9]+") of - {match, _, _} -> + 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) -> - {ok,CleanedString,_} = - inets_regexp:gsub(String, "^[ \t\n\r\f]*|[ \t\n\r\f]*\$",""), - CleanedString. + re:replace(String, "^[ \t\n\r\f]*|[ \t\n\r\f]*\$","", + [{return,list}, global]). custom_clean(String,MoreBefore,MoreAfter) -> - {ok,CleanedString,_} = inets_regexp:gsub(String,"^[ \t\n\r\f"++MoreBefore++ - "]*|[ \t\n\r\f"++MoreAfter++"]*\$",""), - CleanedString. + re:replace(String, + "^[ \t\n\r\f"++MoreBefore++ + "]*|[ \t\n\r\f"++MoreAfter++"]*\$","", + [{return,list}, global]). + check_enum(_Enum,[]) -> {error, not_valid}; diff --git a/lib/inets/src/http_server/httpd_request.erl b/lib/inets/src/http_server/httpd_request.erl index abcc0ce898..749f58c197 100644 --- a/lib/inets/src/http_server/httpd_request.erl +++ b/lib/inets/src/http_server/httpd_request.erl @@ -86,7 +86,8 @@ body_data(Headers, Body) -> %%------------------------------------------------------------------------- %% validate(Method, Uri, Version) -> ok | {error, {bad_request, Reason} | %% {error, {not_supported, {Method, Uri, Version}} -%% Method = "HEAD" | "GET" | "POST" | "TRACE" | "PUT" | "DELETE" +%% Method = "HEAD" | "GET" | "POST" | "PATCH" | "TRACE" | "PUT" +%% | "DELETE" %% Uri = uri() %% Version = "HTTP/N.M" %% Description: Checks that HTTP-request-line is valid. @@ -105,6 +106,8 @@ validate("DELETE", Uri, "HTTP/1." ++ _N) -> validate_uri(Uri); validate("POST", Uri, "HTTP/1." ++ _N) -> validate_uri(Uri); +validate("PATCH", Uri, "HTTP/1." ++ _N) -> + validate_uri(Uri); validate("TRACE", Uri, "HTTP/1." ++ N) when hd(N) >= $1 -> validate_uri(Uri); validate(Method, Uri, Version) -> diff --git a/lib/inets/src/http_server/httpd_script_env.erl b/lib/inets/src/http_server/httpd_script_env.erl index 21b22f4420..232bf96bd4 100644 --- a/lib/inets/src/http_server/httpd_script_env.erl +++ b/lib/inets/src/http_server/httpd_script_env.erl @@ -104,7 +104,7 @@ create_http_header_elements(ScriptType, [{Name, [Value | _] = Values } | create_http_header_elements(ScriptType, [{Name, Value} | Headers], Acc) when is_list(Value) -> - {ok, NewName, _} = inets_regexp:gsub(Name,"-","_"), + NewName = re:replace(Name,"-","_", [{return,list}, global]), Element = http_env_element(ScriptType, NewName, Value), create_http_header_elements(ScriptType, Headers, [Element | Acc]). diff --git a/lib/inets/src/http_server/httpd_util.erl b/lib/inets/src/http_server/httpd_util.erl index ab43f0b378..6dd6db6a0c 100644 --- a/lib/inets/src/http_server/httpd_util.erl +++ b/lib/inets/src/http_server/httpd_util.erl @@ -420,11 +420,11 @@ flatlength([],L) -> %% split_path split_path(Path) -> - case inets_regexp:match(Path,"[\?].*\$") of + case re:run(Path,"[\?].*\$", [{capture, first}]) of %% A QUERY_STRING exists! - {match,Start,Length} -> - {http_uri:decode(string:substr(Path,1,Start-1)), - string:substr(Path,Start,Length)}; + {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,[]) @@ -522,25 +522,8 @@ remove_ws(Rest) -> %% split -split(String,RegExp,Limit) -> - case inets_regexp:parse(RegExp) of - {error,Reason} -> - {error,Reason}; - {ok,_} -> - {ok,do_split(String,RegExp,Limit)} - end. - -do_split(String, _RegExp, 1) -> - [String]; - -do_split(String,RegExp,Limit) -> - case inets_regexp:first_match(String,RegExp) of - {match,Start,Length} -> - [string:substr(String,1,Start-1)| - do_split(lists:nthtail(Start+Length-1,String),RegExp,Limit-1)]; - nomatch -> - [String] - end. +split(String,RegExp,N) -> + {ok, re:split(String, RegExp, [{parts, N}, {return, list}])}. %% make_name/2, make_name/3 %% Prefix -> string() diff --git a/lib/inets/src/http_server/mod_actions.erl b/lib/inets/src/http_server/mod_actions.erl index d879328876..154fde294e 100644 --- a/lib/inets/src/http_server/mod_actions.erl +++ b/lib/inets/src/http_server/mod_actions.erl @@ -81,18 +81,18 @@ script(RequestURI, Method, [_ | Rest]) -> %% load load("Action "++ Action, []) -> - case inets_regexp:split(Action, " ") of - {ok,[MimeType, CGIScript]} -> - {ok,[],{action, {MimeType, CGIScript}}}; - {ok,_} -> - {error,?NICE(string:strip(Action)++" is an invalid 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 inets_regexp:split(Script, " ") of - {ok,[Method, CGIScript]} -> - {ok,[],{script, {Method, CGIScript}}}; - {ok,_} -> - {error,?NICE(string:strip(Script)++" is an invalid 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), diff --git a/lib/inets/src/http_server/mod_alias.erl b/lib/inets/src/http_server/mod_alias.erl index 8dd4871821..727f6e0ce3 100644 --- a/lib/inets/src/http_server/mod_alias.erl +++ b/lib/inets/src/http_server/mod_alias.erl @@ -113,32 +113,52 @@ real_name(ConfigDB, RequestURI, []) -> httpd_util:split_path(default_index(ConfigDB, RealName)), {ShortPath, Path, AfterPath}; -real_name(ConfigDB, RequestURI, [{MP,Replacement}|Rest]) +real_name(ConfigDB, RequestURI, [{MP,Replacement}| _] = Aliases) when element(1, MP) =:= re_pattern -> - case re:run(RequestURI, MP, [{capture,[]}]) of - match -> + case longest_match(Aliases, RequestURI) of + {match, {MP, Replacement}} -> NewURI = re:replace(RequestURI, MP, Replacement, [{return,list}]), {ShortPath,_} = httpd_util:split_path(NewURI), {Path,AfterPath} = httpd_util:split_path(default_index(ConfigDB, NewURI)), {ShortPath, Path, AfterPath}; nomatch -> - real_name(ConfigDB, RequestURI, Rest) + real_name(ConfigDB, RequestURI, []) end; -real_name(ConfigDB, RequestURI, [{FakeName,RealName}|Rest]) -> - case inets_regexp:match(RequestURI, "^" ++ FakeName) of - {match, _, _} -> - {ok, ActualName, _} = inets_regexp:sub(RequestURI, - "^" ++ FakeName, RealName), +real_name(ConfigDB, RequestURI, [{_,_}|_] = Aliases) -> + case longest_match(Aliases, RequestURI) of + {match, {FakeName, RealName}} -> + ActualName = re:replace(RequestURI, + "^" ++ FakeName, RealName, [{return,list}]), {ShortPath, _AfterPath} = httpd_util:split_path(ActualName), {Path, AfterPath} = - httpd_util:split_path(default_index(ConfigDB, ActualName)), + httpd_util:split_path(default_index(ConfigDB, ActualName)), {ShortPath, Path, AfterPath}; - nomatch -> - real_name(ConfigDB, RequestURI, Rest) + nomatch -> + real_name(ConfigDB, RequestURI, []) end. +longest_match(Aliases, RequestURI) -> + longest_match(Aliases, RequestURI, _LongestNo = 0, _LongestAlias = undefined). + +longest_match([{FakeName, RealName} | Rest], RequestURI, LongestNo, LongestAlias) -> + case re:run(RequestURI, "^" ++ FakeName, [{capture, first}]) of + {match, [{_, Length}]} -> + if + Length > LongestNo -> + longest_match(Rest, RequestURI, Length, {FakeName, RealName}); + true -> + longest_match(Rest, RequestURI, LongestNo, LongestAlias) + end; + nomatch -> + longest_match(Rest, RequestURI, LongestNo, LongestAlias) + end; +longest_match([], _RequestURI, 0, _LongestAlias) -> + nomatch; +longest_match([], _RequestURI, _LongestNo, LongestAlias) -> + {match, LongestAlias}. + %% real_script_name real_script_name(_ConfigDB, _RequestURI, []) -> @@ -146,7 +166,7 @@ real_script_name(_ConfigDB, _RequestURI, []) -> real_script_name(ConfigDB, RequestURI, [{MP,Replacement} | Rest]) when element(1, MP) =:= re_pattern -> - case re:run(RequestURI, MP, [{capture,[]}]) of + case re:run(RequestURI, MP, [{capture, none}]) of match -> ActualName = re:replace(RequestURI, MP, Replacement, [{return,list}]), @@ -156,10 +176,10 @@ real_script_name(ConfigDB, RequestURI, [{MP,Replacement} | Rest]) end; real_script_name(ConfigDB, RequestURI, [{FakeName,RealName} | Rest]) -> - case inets_regexp:match(RequestURI, "^" ++ FakeName) of - {match,_,_} -> - {ok, ActualName, _} = - inets_regexp:sub(RequestURI, "^" ++ FakeName, RealName), + case re:run(RequestURI, "^" ++ FakeName, [{capture, none}]) of + match -> + ActualName = + re:replace(RequestURI, "^" ++ FakeName, RealName, [{return,list}]), httpd_util:split_script_path(default_index(ConfigDB, ActualName)); nomatch -> real_script_name(ConfigDB, RequestURI, Rest) @@ -206,26 +226,26 @@ path(Data, ConfigDB, RequestURI) -> %% load load("DirectoryIndex " ++ DirectoryIndex, []) -> - {ok, DirectoryIndexes} = inets_regexp:split(DirectoryIndex," "), + DirectoryIndexes = re:split(DirectoryIndex," ", [{return, list}]), {ok,[], {directory_index, DirectoryIndexes}}; load("Alias " ++ Alias, []) -> - case inets_regexp:split(Alias," ") of - {ok, [FakeName, RealName]} -> + case re:split(Alias," ", [{return, list}]) of + [FakeName, RealName] -> {ok,[],{alias,{FakeName,RealName}}}; - {ok, _} -> + _ -> {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 inets_regexp:split(ScriptAlias, " ") of - {ok, [FakeName, RealName]} -> + 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++"/"}}}; - {ok, _} -> + _ -> {error, ?NICE(string:strip(ScriptAlias)++ - " is an invalid ScriptAlias")} + " is an invalid ScriptAlias")} end; load("ScriptReWrite " ++ Rule, Acc) -> load_re_write(Rule, Acc, "ScriptReWrite", script_re_write). diff --git a/lib/inets/src/http_server/mod_auth.erl b/lib/inets/src/http_server/mod_auth.erl index 6195e1c69f..b03629cabe 100644 --- a/lib/inets/src/http_server/mod_auth.erl +++ b/lib/inets/src/http_server/mod_auth.erl @@ -168,38 +168,38 @@ load("AuthDBType " ++ Type, end; load("require " ++ Require,[{directory, {Directory, DirData}}|Rest]) -> - case inets_regexp:split(Require," ") of - {ok,["user"|Users]} -> + case re:split(Require," ", [{return, list}]) of + ["user" | Users] -> {ok,[{directory, {Directory, - [{require_user,Users}|DirData]}} | Rest]}; - {ok,["group"|Groups]} -> + [{require_user,Users}|DirData]}} | Rest]}; + ["group"|Groups] -> {ok,[{directory, {Directory, - [{require_group,Groups}|DirData]}} | Rest]}; - {ok,_} -> + [{require_group,Groups}|DirData]}} | Rest]}; + _ -> {error,?NICE(string:strip(Require) ++" is an invalid require")} end; load("allow " ++ Allow,[{directory, {Directory, DirData}}|Rest]) -> - case inets_regexp:split(Allow," ") of - {ok,["from","all"]} -> + case re:split(Allow," ", [{return, list}]) of + ["from","all"] -> {ok,[{directory, {Directory, [{allow_from,all}|DirData]}} | Rest]}; - {ok,["from"|Hosts]} -> + ["from"|Hosts] -> {ok,[{directory, {Directory, [{allow_from,Hosts}|DirData]}} | Rest]}; - {ok,_} -> + _ -> {error,?NICE(string:strip(Allow) ++" is an invalid allow")} end; load("deny " ++ Deny,[{directory, {Directory, DirData}}|Rest]) -> - case inets_regexp:split(Deny," ") of - {ok, ["from", "all"]} -> + case re:split(Deny," ", [{return, list}]) of + ["from", "all"] -> {ok,[{{directory, Directory, [{deny_from, all}|DirData]}} | Rest]}; - {ok, ["from"|Hosts]} -> + ["from"|Hosts] -> {ok,[{{directory, Directory, [{deny_from, Hosts}|DirData]}} | Rest]}; - {ok, _} -> + _ -> {error,?NICE(string:strip(Deny) ++" is an invalid deny")} end; @@ -561,12 +561,12 @@ secret_path(_Path, [], to_be_found) -> secret_path(_Path, [], Directory) -> {yes, Directory}; secret_path(Path, [[NewDirectory] | Rest], Directory) -> - case inets_regexp:match(Path, NewDirectory) of - {match, _, _} when Directory =:= to_be_found -> + case re:run(Path, NewDirectory, [{capture, first}]) of + {match, _} when Directory =:= to_be_found -> secret_path(Path, Rest, NewDirectory); - {match, _, Length} when Length > length(Directory)-> + {match, [{_, Length}]} when Length > length(Directory)-> secret_path(Path, Rest,NewDirectory); - {match, _, _Length} -> + {match, _} -> secret_path(Path, Rest, Directory); nomatch -> secret_path(Path, Rest, Directory) @@ -588,8 +588,8 @@ validate_addr(_RemoteAddr, none) -> % When called from 'deny' validate_addr(_RemoteAddr, []) -> false; validate_addr(RemoteAddr, [HostRegExp | Rest]) -> - case inets_regexp:match(RemoteAddr, HostRegExp) of - {match,_,_} -> + case re:run(RemoteAddr, HostRegExp, [{capture, none}]) of + match -> true; nomatch -> validate_addr(RemoteAddr,Rest) diff --git a/lib/inets/src/http_server/mod_auth_plain.erl b/lib/inets/src/http_server/mod_auth_plain.erl index e85d3b8776..1a3120e03c 100644 --- a/lib/inets/src/http_server/mod_auth_plain.erl +++ b/lib/inets/src/http_server/mod_auth_plain.erl @@ -244,11 +244,11 @@ parse_group(Stream, GroupList, "") -> parse_group(Stream, GroupList, [$#|_]) -> parse_group(Stream, GroupList); parse_group(Stream, GroupList, Line) -> - case inets_regexp:split(Line, ":") of - {ok, [Group,Users]} -> - {ok, UserList} = inets_regexp:split(Users," "), + case re:split(Line, ":", [{return, list}]) of + [Group,Users] -> + UserList = re:split(Users," ", [{return, list}]), parse_group(Stream, [{Group,UserList}|GroupList]); - {ok, _} -> + _ -> {error, ?NICE(Line)} end. @@ -278,10 +278,10 @@ parse_passwd(Stream, PasswdList, "") -> parse_passwd(Stream, PasswdList, [$#|_]) -> parse_passwd(Stream, PasswdList); parse_passwd(Stream, PasswdList, Line) -> - case inets_regexp:split(Line,":") of - {ok, [User,Password]} -> + case re:split(Line,":", [{return, list}]) of + [User,Password] -> parse_passwd(Stream, [{User,Password, []}|PasswdList]); - {ok,_} -> + _ -> {error, ?NICE(Line)} end. diff --git a/lib/inets/src/http_server/mod_browser.erl b/lib/inets/src/http_server/mod_browser.erl index ca643ab728..e3c41793ae 100644 --- a/lib/inets/src/http_server/mod_browser.erl +++ b/lib/inets/src/http_server/mod_browser.erl @@ -98,9 +98,9 @@ getBrowser1(Info) -> getBrowser(AgentString) -> LAgentString = http_util:to_lower(AgentString), - case inets_regexp:first_match(LAgentString,"^[^ ]*") of - {match,Start,Length} -> - Browser = lists:sublist(LAgentString,Start,Length), + 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, @@ -164,8 +164,8 @@ operativeSystem(OpString,[{RetVal,RegExps}|Rest]) -> controlOperativeSystem(_OpString,[]) -> false; controlOperativeSystem(OpString,[Regexp|Regexps]) -> - case inets_regexp:match(OpString,Regexp) of - {match,_,_} -> + case re:run(OpString,Regexp, [{capture, none}]) of + match -> true; nomatch -> controlOperativeSystem(OpString,Regexps) @@ -182,18 +182,19 @@ controlOperativeSystem(OpString,[Regexp|Regexps]) -> getMozilla(_AgentString,[],Default) -> Default; getMozilla(AgentString,[{Agent,AgentRegExp}|Rest],Default) -> - case inets_regexp:match(AgentString,AgentRegExp) of - {match,_,_} -> + case re:run(AgentString,AgentRegExp, [{capture, none}]) of + match -> {Agent,getMozVersion(AgentString,AgentRegExp)}; nomatch -> getMozilla(AgentString,Rest,Default) end. getMozVersion(AgentString, AgentRegExp) -> - case inets_regexp:match(AgentString,AgentRegExp++"[0-9\.\ \/]*") of - {match,Start,Length} when length(AgentRegExp) < Length -> + 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+length(AgentRegExp), + RealStart = Start+1+length(AgentRegExp), RealLength = Length-length(AgentRegExp), VsnString = string:substr(AgentString,RealStart,RealLength), %% case string:strip(VsnString,both,$\ ) of diff --git a/lib/inets/src/http_server/mod_cgi.erl b/lib/inets/src/http_server/mod_cgi.erl index 25d9f05028..ec8b9be32e 100644 --- a/lib/inets/src/http_server/mod_cgi.erl +++ b/lib/inets/src/http_server/mod_cgi.erl @@ -337,6 +337,8 @@ script_elements(#mod{method = "GET"}, {PathInfo, QueryString}) -> [{query_string, QueryString}, {path_info, PathInfo}]; script_elements(#mod{method = "POST", entity_body = Body}, _) -> [{entity_body, Body}]; +script_elements(#mod{method = "PATCH", entity_body = Body}, _) -> + [{entity_body, Body}]; script_elements(#mod{method = "PUT", entity_body = Body}, _) -> [{entity_body, Body}]; script_elements(_, _) -> diff --git a/lib/inets/src/http_server/mod_dir.erl b/lib/inets/src/http_server/mod_dir.erl index 9d848ac013..2d8f27af3c 100644 --- a/lib/inets/src/http_server/mod_dir.erl +++ b/lib/inets/src/http_server/mod_dir.erl @@ -125,12 +125,13 @@ header(Path,RequestURI) -> RequestURI ++ "</H1>\n<PRE><IMG SRC=\"" ++ icon(blank) ++ "\" ALT=" "> Name Last modified " "Size Description <HR>\n", - case inets_regexp:sub(RequestURI,"[^/]*\$","") of - {ok,"/",_} -> + case re:replace(RequestURI,"[^/]*\$","", [{return,list}]) of + "/" -> Header; - {ok,ParentRequestURI,_} -> - {ok,ParentPath,_} = - inets_regexp:sub(string:strip(Path,right,$/),"[^/]*\$",""), + ParentRequestURI -> + ParentPath = + re:replace(string:strip(Path,right,$/),"[^/]*\$","", + [{return,list}]), Header++format(ParentPath,ParentRequestURI) end. diff --git a/lib/inets/src/http_server/mod_disk_log.erl b/lib/inets/src/http_server/mod_disk_log.erl index a0ff929a34..5e395a2118 100644 --- a/lib/inets/src/http_server/mod_disk_log.erl +++ b/lib/inets/src/http_server/mod_disk_log.erl @@ -138,8 +138,8 @@ do(Info) -> %% Description: See httpd(3) ESWAPI CALLBACK FUNCTIONS %%------------------------------------------------------------------------- load("TransferDiskLogSize " ++ TransferDiskLogSize, []) -> - case inets_regexp:split(TransferDiskLogSize," ") of - {ok,[MaxBytes,MaxFiles]} -> + try re:split(TransferDiskLogSize, " ", [{return, list}]) of + [MaxBytes, MaxFiles] -> case make_integer(MaxBytes) of {ok,MaxBytesInteger} -> case make_integer(MaxFiles) of @@ -151,17 +151,20 @@ load("TransferDiskLogSize " ++ TransferDiskLogSize, []) -> ?NICE(string:strip(TransferDiskLogSize)++ " is an invalid TransferDiskLogSize")} end; - {error,_} -> + _ -> {error,?NICE(string:strip(TransferDiskLogSize)++ - " is an invalid TransferDiskLogSize")} + " is an invalid TransferDiskLogSize")} end + catch _:_ -> + {error,?NICE(string:strip(TransferDiskLogSize) ++ + " is an invalid TransferDiskLogSize")} end; load("TransferDiskLog " ++ TransferDiskLog,[]) -> {ok,[],{transfer_disk_log,string:strip(TransferDiskLog)}}; load("ErrorDiskLogSize " ++ ErrorDiskLogSize, []) -> - case inets_regexp:split(ErrorDiskLogSize," ") of - {ok,[MaxBytes,MaxFiles]} -> + try re:split(ErrorDiskLogSize," ", [{return, list}]) of + [MaxBytes,MaxFiles] -> case make_integer(MaxBytes) of {ok,MaxBytesInteger} -> case make_integer(MaxFiles) of @@ -176,13 +179,16 @@ load("ErrorDiskLogSize " ++ ErrorDiskLogSize, []) -> {error,?NICE(string:strip(ErrorDiskLogSize)++ " is an invalid ErrorDiskLogSize")} end + catch _:_ -> + {error,?NICE(string:strip(ErrorDiskLogSize) ++ + " is an invalid TransferDiskLogSize")} end; load("ErrorDiskLog " ++ ErrorDiskLog, []) -> {ok, [], {error_disk_log, string:strip(ErrorDiskLog)}}; load("SecurityDiskLogSize " ++ SecurityDiskLogSize, []) -> - case inets_regexp:split(SecurityDiskLogSize, " ") of - {ok, [MaxBytes, MaxFiles]} -> + try re:split(SecurityDiskLogSize, " ", [{return, list}]) of + [MaxBytes, MaxFiles] -> case make_integer(MaxBytes) of {ok, MaxBytesInteger} -> case make_integer(MaxFiles) of @@ -198,6 +204,9 @@ load("SecurityDiskLogSize " ++ SecurityDiskLogSize, []) -> {error, ?NICE(string:strip(SecurityDiskLogSize) ++ " is an invalid SecurityDiskLogSize")} end + catch _:_ -> + {error,?NICE(string:strip(SecurityDiskLogSize) ++ + " is an invalid SecurityDiskLogSize")} end; load("SecurityDiskLog " ++ SecurityDiskLog, []) -> {ok, [], {security_disk_log, string:strip(SecurityDiskLog)}}; diff --git a/lib/inets/src/http_server/mod_esi.erl b/lib/inets/src/http_server/mod_esi.erl index 1923411449..2978ac9095 100644 --- a/lib/inets/src/http_server/mod_esi.erl +++ b/lib/inets/src/http_server/mod_esi.erl @@ -96,26 +96,27 @@ do(ModData) -> %% Description: See httpd(3) ESWAPI CALLBACK FUNCTIONS %%------------------------------------------------------------------------- load("ErlScriptAlias " ++ ErlScriptAlias, []) -> - case inets_regexp:split(ErlScriptAlias," ") of - {ok, [ErlName | StrModules]} -> + 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}}}; - {ok, _} -> + {ok, [], {erl_script_alias, {ErlName, Modules}}} + catch _:_ -> {error, ?NICE(string:strip(ErlScriptAlias) ++ - " is an invalid ErlScriptAlias")} + " is an invalid ErlScriptAlias")} end; load("EvalScriptAlias " ++ EvalScriptAlias, []) -> - case inets_regexp:split(EvalScriptAlias, " ") of - {ok, [EvalName | StrModules]} -> + 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}}}; - {ok, _} -> + {ok, [], {eval_script_alias, {EvalName, Modules}}} + catch + _:_ -> {error, ?NICE(string:strip(EvalScriptAlias) ++ - " is an invalid EvalScriptAlias")} + " is an invalid EvalScriptAlias")} end; load("ErlScriptTimeout " ++ Timeout, [])-> case catch list_to_integer(string:strip(Timeout)) of @@ -224,8 +225,8 @@ match_esi_script(_, [], _) -> no_match; match_esi_script(RequestURI, [{Alias,Modules} | Rest], AliasType) -> AliasMatchStr = alias_match_str(Alias, AliasType), - case inets_regexp:first_match(RequestURI, AliasMatchStr) of - {match, 1, Length} -> + case re:run(RequestURI, AliasMatchStr, [{capture, first}]) of + {match, [{0, Length}]} -> {string:substr(RequestURI, Length + 1), Modules}; nomatch -> match_esi_script(RequestURI, Rest, AliasType) @@ -281,6 +282,15 @@ erl(#mod{request_uri = ReqUri, ?NICE("Erl mechanism doesn't support method DELETE")}}| Data]}; +erl(#mod{request_uri = ReqUri, + method = "PATCH", + http_version = Version, + data = Data}, _ESIBody, _Modules) -> + ?hdrt("erl", [{method, patch}]), + {proceed, [{status,{501,{"PATCH", ReqUri, Version}, + ?NICE("Erl mechanism doesn't support method PATCH")}}| + Data]}; + erl(#mod{method = "POST", entity_body = Body} = ModData, ESIBody, Modules) -> ?hdrt("erl", [{method, post}]), @@ -584,9 +594,9 @@ generate_webpage(ESIBody) -> is_authorized(_ESIBody, [all]) -> true; is_authorized(ESIBody, Modules) -> - case inets_regexp:match(ESIBody, "^[^\:(%3A)]*") of - {match, Start, Length} -> - lists:member(list_to_atom(string:substr(ESIBody, Start, Length)), + 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 diff --git a/lib/inets/src/http_server/mod_htaccess.erl b/lib/inets/src/http_server/mod_htaccess.erl index c6ae20ced7..f229c96f2d 100644 --- a/lib/inets/src/http_server/mod_htaccess.erl +++ b/lib/inets/src/http_server/mod_htaccess.erl @@ -327,9 +327,9 @@ memberNetwork(Networks,UserNetwork,IfTrue,IfFalse)-> %ipadresses or subnet addresses. memberNetwork(Networks,UserNetwork)-> case lists:filter(fun(Net)-> - case inets_regexp:match(UserNetwork, - formatRegexp(Net)) of - {match,1,_}-> + case re:run(UserNetwork, + formatRegexp(Net), [{capture, first}]) of + {match,[{0,_}]}-> true; _NotSubNet -> false @@ -638,13 +638,8 @@ getHtAccessFileNames(Info)-> %HtAccessFileNames=["accessfileName1",..."AccessFileName2"] %---------------------------------------------------------------------- getData(Path,Info,HtAccessFileNames)-> - case inets_regexp:split(Path,"/") of - {error,Error}-> - {error,Error}; - {ok,SplittedPath}-> - getData2(HtAccessFileNames,SplittedPath,Info) - end. - + SplittedPath = re:split(Path, "/", [{return, list}]), + getData2(HtAccessFileNames,SplittedPath,Info). %---------------------------------------------------------------------- %Add to together the data in the Splittedpath up to the path @@ -942,20 +937,16 @@ getAuthorizationType(AuthType)-> %Returns a list of the specified methods to limit or the atom all %---------------------------------------------------------------------- getLimits(Limits)-> - case inets_regexp:split(Limits,">")of - {ok,[_NoEndOnLimit]}-> + case re:split(Limits,">", [{return, list}])of + [_NoEndOnLimit]-> error; - {ok, [Methods | _Crap]}-> - case inets_regexp:split(Methods," ") of - {ok,[]}-> + [Methods | _Crap]-> + case re:split(Methods," ", [{return, list}]) of + [[]]-> all; - {ok,SplittedMethods}-> - SplittedMethods; - {error, _Error}-> - error - end; - {error,_Error}-> - error + SplittedMethods -> + SplittedMethods + end end. diff --git a/lib/inets/src/http_server/mod_security.erl b/lib/inets/src/http_server/mod_security.erl index 20f87619c1..1f936d598a 100644 --- a/lib/inets/src/http_server/mod_security.erl +++ b/lib/inets/src/http_server/mod_security.erl @@ -273,12 +273,12 @@ secret_path(_Path, [], to_be_found) -> secret_path(_Path, [], Dir) -> {yes, Dir}; secret_path(Path, [[NewDir]|Rest], Dir) -> - case inets_regexp:match(Path, NewDir) of - {match, _, _} when Dir =:= to_be_found -> + case re:run(Path, NewDir, [{capture, first}]) of + {match, _} when Dir =:= to_be_found -> secret_path(Path, Rest, NewDir); - {match, _, Length} when Length > length(Dir) -> + {match, [{_, Length}]} when Length > length(Dir) -> secret_path(Path, Rest, NewDir); - {match, _, _} -> + {match, _} -> secret_path(Path, Rest, Dir); nomatch -> secret_path(Path, Rest, Dir) diff --git a/lib/inets/src/inets_app/Makefile b/lib/inets/src/inets_app/Makefile index 82cda6aaf0..0a4b625b6a 100644 --- a/lib/inets/src/inets_app/Makefile +++ b/lib/inets/src/inets_app/Makefile @@ -47,7 +47,6 @@ MODULES = \ inets_service \ inets_app \ inets_sup \ - inets_regexp \ inets_trace \ inets_lib \ inets_time_compat diff --git a/lib/inets/src/inets_app/inets.app.src b/lib/inets/src/inets_app/inets.app.src index 883ba84e8e..2f213794a3 100644 --- a/lib/inets/src/inets_app/inets.app.src +++ b/lib/inets/src/inets_app/inets.app.src @@ -26,7 +26,6 @@ inets_sup, inets_app, inets_service, - inets_regexp, inets_trace, inets_lib, inets_time_compat, diff --git a/lib/inets/src/inets_app/inets_regexp.erl b/lib/inets/src/inets_app/inets_regexp.erl deleted file mode 100644 index fc1608bc5a..0000000000 --- a/lib/inets/src/inets_app/inets_regexp.erl +++ /dev/null @@ -1,414 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2009. 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(inets_regexp). - --export([parse/1, match/2, first_match/2, split/2, sub/3, gsub/3]). - - -%%%========================================================================= -%%% API -%%%========================================================================= - -%% parse(RegExp) -> {ok, RE} | {error, E}. -%% Parse the regexp described in the string RegExp. - -parse(S) -> - case (catch reg(S)) of - {R, []} -> - {ok, R}; - {_R, [C|_]} -> - {error, {illegal, [C]}}; - {error, E} -> - {error, E} - end. - - -%% Find the longest match of RegExp in String. - -match(S, RegExp) when is_list(RegExp) -> - case parse(RegExp) of - {ok,RE} -> match(S, RE); - {error,E} -> {error,E} - end; -match(S, RE) -> - case match(RE, S, 1, 0, -1) of - {Start,Len} when Len >= 0 -> - {match, Start, Len}; - {_Start,_Len} -> - nomatch - end. - -%% Find the first match of RegExp in String. - -first_match(S, RegExp) when is_list(RegExp) -> - case parse(RegExp) of - {ok, RE} -> - first_match(S, RE); - {error, E} -> - {error, E} - end; -first_match(S, RE) -> - case first_match(RE, S, 1) of - {Start,Len} when Len >= 0 -> - {match, Start,Len}; - nomatch -> - nomatch - end. - -first_match(RE, S, St) when S =/= [] -> - case re_apply(S, St, RE) of - {match, P, _Rest} -> - {St, P-St}; - nomatch -> - first_match(RE, tl(S), St+1) - end; -first_match(_RE, [], _St) -> - nomatch. - - -match(RE, S, St, Pos, L) -> - case first_match(RE, S, St) of - {St1, L1} -> - Nst = St1 + 1, - if L1 > L -> - match(RE, lists:nthtail(Nst-St, S), Nst, St1, L1); - true -> - match(RE, lists:nthtail(Nst-St, S), Nst, Pos, L) - end; - nomatch -> - {Pos, L} - end. - - -%% Split a string into substrings where the RegExp describes the -%% field seperator. The RegExp " " is specially treated. - -split(String, " ") -> %This is really special - {ok, RE} = parse("[ \t]+"), - case split_apply(String, RE, true) of - [[]|Ss] -> - {ok,Ss}; - Ss -> - {ok,Ss} - end; -split(String, RegExp) when is_list(RegExp) -> - case parse(RegExp) of - {ok, RE} -> - {ok, split_apply(String, RE, false)}; - {error, E} -> - {error,E} - end; -split(String, RE) -> - {ok, split_apply(String, RE, false)}. - - -%% Substitute the first match of the regular expression RegExp -%% with the string Replace in String. Accept pre-parsed regular -%% expressions. - -sub(String, RegExp, Rep) when is_list(RegExp) -> - case parse(RegExp) of - {ok, RE} -> - sub(String, RE, Rep); - {error, E} -> - {error, E} - end; -sub(String, RE, Rep) -> - Ss = sub_match(String, RE, 1), - {ok, sub_repl(Ss, Rep, String, 1), length(Ss)}. - - -%% Substitute every match of the regular expression RegExp with -%% the string New in String. Accept pre-parsed regular expressions. - -gsub(String, RegExp, Rep) when is_list(RegExp) -> - case parse(RegExp) of - {ok, RE} -> - gsub(String, RE, Rep); - {error, E} -> - {error, E} - end; -gsub(String, RE, Rep) -> - Ss = matches(String, RE, 1), - {ok, sub_repl(Ss, Rep, String, 1), length(Ss)}. - - -%%%======================================================================== -%%% Internal functions -%%%======================================================================== - -%% This is the regular expression grammar used. It is equivalent to the -%% one used in AWK, except that we allow ^ $ to be used anywhere and fail -%% in the matching. -%% -%% reg -> reg1 : '$1'. -%% reg1 -> reg1 "|" reg2 : {'or','$1','$2'}. -%% reg1 -> reg2 : '$1'. -%% reg2 -> reg2 reg3 : {concat,'$1','$2'}. -%% reg2 -> reg3 : '$1'. -%% reg3 -> reg3 "*" : {kclosure,'$1'}. -%% reg3 -> reg3 "+" : {pclosure,'$1'}. -%% reg3 -> reg3 "?" : {optional,'$1'}. -%% reg3 -> reg4 : '$1'. -%% reg4 -> "(" reg ")" : '$2'. -%% reg4 -> "\\" char : '$2'. -%% reg4 -> "^" : bos. -%% reg4 -> "$" : eos. -%% reg4 -> "." : char. -%% reg4 -> "[" class "]" : {char_class,char_class('$2')} -%% reg4 -> "[" "^" class "]" : {comp_class,char_class('$3')} -%% reg4 -> "\"" chars "\"" : char_string('$2') -%% reg4 -> char : '$1'. -%% reg4 -> empty : epsilon. -%% The grammar of the current regular expressions. The actual parser -%% is a recursive descent implementation of the grammar. - -reg(S) -> reg1(S). - -%% reg1 -> reg2 reg1' -%% reg1' -> "|" reg2 -%% reg1' -> empty - -reg1(S0) -> - {L,S1} = reg2(S0), - reg1p(S1, L). - -reg1p([$||S0], L) -> - {R,S1} = reg2(S0), - reg1p(S1, {'or',L,R}); -reg1p(S, L) -> {L,S}. - -%% reg2 -> reg3 reg2' -%% reg2' -> reg3 -%% reg2' -> empty - -reg2(S0) -> - {L,S1} = reg3(S0), - reg2p(S1, L). - -reg2p([C|S0], L) when (C =/= $|) andalso (C =/= $)) -> - {R,S1} = reg3([C|S0]), - reg2p(S1, {concat,L,R}); -reg2p(S, L) -> {L,S}. - -%% reg3 -> reg4 reg3' -%% reg3' -> "*" reg3' -%% reg3' -> "+" reg3' -%% reg3' -> "?" reg3' -%% reg3' -> empty - -reg3(S0) -> - {L,S1} = reg4(S0), - reg3p(S1, L). - -reg3p([$*|S], L) -> reg3p(S, {kclosure,L}); -reg3p([$+|S], L) -> reg3p(S, {pclosure,L}); -reg3p([$?|S], L) -> reg3p(S, {optional,L}); -reg3p(S, L) -> {L,S}. - -reg4([$(|S0]) -> - case reg(S0) of - {R,[$)|S1]} -> {R,S1}; - {_R,_S} -> throw({error,{unterminated,"("}}) - end; -reg4([$\\,O1,O2,O3|S]) - when ((O1 >= $0) andalso - (O1 =< $7) andalso - (O2 >= $0) andalso - (O2 =< $7) andalso - (O3 >= $0) andalso - (O3 =< $7)) -> - {(O1*8 + O2)*8 + O3 - 73*$0,S}; -reg4([$\\,C|S]) -> - {escape_char(C),S}; -reg4([$\\]) -> - throw({error, {unterminated,"\\"}}); -reg4([$^|S]) -> - {bos,S}; -reg4([$$|S]) -> - {eos,S}; -reg4([$.|S]) -> - {{comp_class,"\n"},S}; -reg4("[^" ++ S0) -> - case char_class(S0) of - {Cc,[$]|S1]} -> {{comp_class,Cc},S1}; - {_Cc,_S} -> throw({error,{unterminated,"["}}) - end; -reg4([$[|S0]) -> - case char_class(S0) of - {Cc,[$]|S1]} -> {{char_class,Cc},S1}; - {_Cc,_S1} -> throw({error,{unterminated,"["}}) - end; -reg4([C|S]) - when (C =/= $*) andalso (C =/= $+) andalso (C =/= $?) andalso (C =/= $]) -> - {C, S}; -reg4([C|_S]) -> - throw({error,{illegal,[C]}}); -reg4([]) -> - {epsilon,[]}. - -escape_char($n) -> $\n; %\n = LF -escape_char($r) -> $\r; %\r = CR -escape_char($t) -> $\t; %\t = TAB -escape_char($v) -> $\v; %\v = VT -escape_char($b) -> $\b; %\b = BS -escape_char($f) -> $\f; %\f = FF -escape_char($e) -> $\e; %\e = ESC -escape_char($s) -> $\s; %\s = SPACE -escape_char($d) -> $\d; %\d = DEL -escape_char(C) -> C. - -char_class([$]|S]) -> char_class(S, [$]]); -char_class(S) -> char_class(S, []). - -char($\\, [O1,O2,O3|S]) when - O1 >= $0, O1 =< $7, O2 >= $0, O2 =< $7, O3 >= $0, O3 =< $7 -> - {(O1*8 + O2)*8 + O3 - 73*$0,S}; -char($\\, [C|S]) -> {escape_char(C),S}; -char(C, S) -> {C,S}. - -char_class([C1|S0], Cc) when C1 =/= $] -> - case char(C1, S0) of - {Cf,[$-,C2|S1]} when C2 =/= $] -> - case char(C2, S1) of - {Cl,S2} when Cf < Cl -> char_class(S2, [{Cf,Cl}|Cc]); - {Cl,_S2} -> throw({error,{char_class,[Cf,$-,Cl]}}) - end; - {C,S1} -> char_class(S1, [C|Cc]) - end; -char_class(S, Cc) -> {Cc,S}. - - -%% re_apply(String, StartPos, RegExp) -> re_app_res(). -%% -%% Apply the (parse of the) regular expression RegExp to String. If -%% there is a match return the position of the remaining string and -%% the string if else return 'nomatch'. BestMatch specifies if we want -%% the longest match, or just a match. -%% -%% StartPos should be the real start position as it is used to decide -%% if we ae at the beginning of the string. -%% -%% Pass two functions to re_apply_or so it can decide, on the basis -%% of BestMatch, whether to just any take any match or try both to -%% find the longest. This is slower but saves duplicatng code. - -re_apply(S, St, RE) -> re_apply(RE, [], S, St). - -re_apply(epsilon, More, S, P) -> %This always matches - re_apply_more(More, S, P); -re_apply({'or',RE1,RE2}, More, S, P) -> - re_apply_or(re_apply(RE1, More, S, P), - re_apply(RE2, More, S, P)); -re_apply({concat,RE1,RE2}, More, S0, P) -> - re_apply(RE1, [RE2|More], S0, P); -re_apply({kclosure,CE}, More, S, P) -> - %% Be careful with the recursion, explicitly do one call before - %% looping. - re_apply_or(re_apply_more(More, S, P), - re_apply(CE, [{kclosure,CE}|More], S, P)); -re_apply({pclosure,CE}, More, S, P) -> - re_apply(CE, [{kclosure,CE}|More], S, P); -re_apply({optional,CE}, More, S, P) -> - re_apply_or(re_apply_more(More, S, P), - re_apply(CE, More, S, P)); -re_apply(bos, More, S, 1) -> re_apply_more(More, S, 1); -re_apply(eos, More, [$\n|S], P) -> re_apply_more(More, S, P); -re_apply(eos, More, [], P) -> re_apply_more(More, [], P); -re_apply({char_class,Cc}, More, [C|S], P) -> - case in_char_class(C, Cc) of - true -> re_apply_more(More, S, P+1); - false -> nomatch - end; -re_apply({comp_class,Cc}, More, [C|S], P) -> - case in_char_class(C, Cc) of - true -> nomatch; - false -> re_apply_more(More, S, P+1) - end; -re_apply(C, More, [C|S], P) when is_integer(C) -> - re_apply_more(More, S, P+1); -re_apply(_RE, _More, _S, _P) -> nomatch. - -%% re_apply_more([RegExp], String, Length) -> re_app_res(). - -re_apply_more([RE|More], S, P) -> re_apply(RE, More, S, P); -re_apply_more([], S, P) -> {match,P,S}. - -%% in_char_class(Char, Class) -> bool(). - -in_char_class(C, [{C1,C2}|_Cc]) when C >= C1, C =< C2 -> true; -in_char_class(C, [C|_Cc]) -> true; -in_char_class(C, [_|Cc]) -> in_char_class(C, Cc); -in_char_class(_C, []) -> false. - -%% re_apply_or(Match1, Match2) -> re_app_res(). -%% If we want the best match then choose the longest match, else just -%% choose one by trying sequentially. - -re_apply_or({match,P1,S1}, {match,P2,_S2}) when P1 >= P2 -> {match,P1,S1}; -re_apply_or({match,_P1,_S1}, {match,P2,S2}) -> {match,P2,S2}; -re_apply_or(nomatch, R2) -> R2; -re_apply_or(R1, nomatch) -> R1. - - -matches(S, RE, St) -> - case first_match(RE, S, St) of - {St1,0} -> - [{St1,0}|matches(string:substr(S, St1+2-St), RE, St1+1)]; - {St1,L1} -> - [{St1,L1}|matches(string:substr(S, St1+L1+1-St), RE, St1+L1)]; - nomatch -> - [] - end. - -sub_match(S, RE, St) -> - case first_match(RE, S, St) of - {St1,L1} -> [{St1,L1}]; - nomatch -> [] - end. - -sub_repl([{St,L}|Ss], Rep, S, Pos) -> - Rs = sub_repl(Ss, Rep, S, St+L), - string:substr(S, Pos, St-Pos) ++ - sub_repl(Rep, string:substr(S, St, L), Rs); -sub_repl([], _Rep, S, Pos) -> - string:substr(S, Pos). - -sub_repl([$&|Rep], M, Rest) -> M ++ sub_repl(Rep, M, Rest); -sub_repl("\\&" ++ Rep, M, Rest) -> [$&|sub_repl(Rep, M, Rest)]; -sub_repl([C|Rep], M, Rest) -> [C|sub_repl(Rep, M, Rest)]; -sub_repl([], _M, Rest) -> Rest. - -split_apply(S, RE, Trim) -> split_apply(S, 1, RE, Trim, []). - -split_apply([], _P, _RE, true, []) -> - []; -split_apply([], _P, _RE, _T, Sub) -> - [lists:reverse(Sub)]; -split_apply(S, P, RE, T, Sub) -> - case re_apply(S, P, RE) of - {match,P,_Rest} -> - split_apply(tl(S), P+1, RE, T, [hd(S)|Sub]); - {match,P1,Rest} -> - [lists:reverse(Sub)|split_apply(Rest, P1, RE, T, [])]; - nomatch -> - split_apply(tl(S), P+1, RE, T, [hd(S)|Sub]) - end. diff --git a/lib/inets/src/tftp/tftp_engine.erl b/lib/inets/src/tftp/tftp_engine.erl index d0510e795b..79203fd1a4 100644 --- a/lib/inets/src/tftp/tftp_engine.erl +++ b/lib/inets/src/tftp/tftp_engine.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%% Copyright Ericsson AB 2005-2015. 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,7 +63,8 @@ -record(file_info, {peer_req, pid}). -record(sys_misc, {module, function, arguments}). -record(error, {where, code, text, filename}). --record(prepared, {status :: prep_status(), result, block_no, next_data, prev_data}). +-record(prepared, {status :: prep_status() | 'undefined', + result, block_no, next_data, prev_data}). -record(transfer_res, {status, decoded_msg, prepared}). -define(ERROR(Where, Code, Text, Filename), #error{where = Where, code = Code, text = Text, filename = Filename}). @@ -1153,8 +1154,8 @@ match_callback(Filename, Callbacks) -> end. do_match_callback(Filename, [C | Tail]) when is_record(C, callback) -> - case catch inets_regexp:match(Filename, C#callback.internal) of - {match, _, _} -> + case catch re:run(Filename, C#callback.internal, [{capture, none}]) of + match -> {ok, C}; nomatch -> do_match_callback(Filename, Tail); diff --git a/lib/inets/src/tftp/tftp_lib.erl b/lib/inets/src/tftp/tftp_lib.erl index 71327f8023..01dea97d07 100644 --- a/lib/inets/src/tftp/tftp_lib.erl +++ b/lib/inets/src/tftp/tftp_lib.erl @@ -184,7 +184,7 @@ do_parse_config([{Key, Val} | Tail], Config) when is_record(Config, config) -> callback -> case Val of {RegExp, Mod, State} when is_list(RegExp), is_atom(Mod) -> - case inets_regexp:parse(RegExp) of + case re:compile(RegExp) of {ok, Internal} -> Callback = #callback{regexp = RegExp, internal = Internal, @@ -253,7 +253,7 @@ do_parse_config(Options, Config) when is_record(Config, config) -> add_default_callbacks(Callbacks) -> RegExp = "", - {ok, Internal} = inets_regexp:parse(RegExp), + {ok, Internal} = re:compile(RegExp), File = #callback{regexp = RegExp, internal = Internal, module = tftp_file, diff --git a/lib/inets/test/Makefile b/lib/inets/test/Makefile index 607ec7c182..67c979bd59 100644 --- a/lib/inets/test/Makefile +++ b/lib/inets/test/Makefile @@ -42,7 +42,6 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) # Target Specs # ---------------------------------------------------- INCLUDES = -I. \ - -I$(ERL_TOP)/lib/test_server/include/ \ -I$(ERL_TOP)/lib/inets/src/inets_app \ -I$(ERL_TOP)/lib/inets/src/http_lib \ -I$(ERL_TOP)/lib/inets/src/http_client \ @@ -238,7 +237,6 @@ RELTESTSYSBINDIR = $(RELTESTSYSALLDATADIR)/bin # running the target "targets". # ---------------------------------------------------- ERL_COMPILE_FLAGS += \ - -pa ../../../internal_tools/test_server/ebin \ $(INCLUDES) \ $(FTP_FLAGS) \ $(INETS_FLAGS) diff --git a/lib/inets/test/ftp_format_SUITE.erl b/lib/inets/test/ftp_format_SUITE.erl index 7ed94b9c61..9b71d2944b 100644 --- a/lib/inets/test/ftp_format_SUITE.erl +++ b/lib/inets/test/ftp_format_SUITE.erl @@ -22,7 +22,6 @@ -author('[email protected]'). -include_lib("common_test/include/ct.hrl"). --include("test_server_line.hrl"). -include("ftp_internal.hrl"). %% Test server specific exports diff --git a/lib/inets/test/ftp_suite_lib.erl b/lib/inets/test/ftp_suite_lib.erl index 6d30f3aa62..2f9170fa0c 100644 --- a/lib/inets/test/ftp_suite_lib.erl +++ b/lib/inets/test/ftp_suite_lib.erl @@ -22,8 +22,8 @@ -module(ftp_suite_lib). --include_lib("test_server/include/test_server.hrl"). --include_lib("test_server/include/test_server_line.hrl"). +-include_lib("common_test/include/ct.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("inets_test_lib.hrl"). %% Test server specific exports diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index c6c59ab1af..93b96e101f 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -68,6 +68,7 @@ real_requests()-> get, post, post_stream, + patch, async, pipeline, persistent_connection, @@ -257,6 +258,28 @@ post(Config) when is_list(Config) -> "text/plain", "foobar"}, [], []). %%-------------------------------------------------------------------- +patch() -> + [{"Test http patch request against local server. We do in this case " + "only care about the client side of the the patch. The server " + "script will not actually use the patch data."}]. +patch(Config) when is_list(Config) -> + CGI = case test_server:os_type() of + {win32, _} -> + "/cgi-bin/cgi_echo.exe"; + _ -> + "/cgi-bin/cgi_echo" + end, + + URL = url(group_name(Config), CGI, Config), + + %% Cgi-script expects the body length to be 100 + Body = lists:duplicate(100, "1"), + + {ok, {{_,200,_}, [_ | _], [_ | _]}} = + httpc:request(patch, {URL, [{"expect","100-continue"}], + "text/plain", Body}, [], []). + +%%-------------------------------------------------------------------- post_stream() -> [{"Test streaming http post request against local server. " "We only care about the client side of the the post. " diff --git a/lib/inets/test/httpc_cookie_SUITE.erl b/lib/inets/test/httpc_cookie_SUITE.erl index 9a62bdb43f..2efca9a5c8 100644 --- a/lib/inets/test/httpc_cookie_SUITE.erl +++ b/lib/inets/test/httpc_cookie_SUITE.erl @@ -20,7 +20,7 @@ %% -module(httpc_cookie_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("stdlib/include/ms_transform.hrl"). %% Test server specific exports diff --git a/lib/inets/test/httpd_1_1.erl b/lib/inets/test/httpd_1_1.erl index db6def9d17..d3a1e3672a 100644 --- a/lib/inets/test/httpd_1_1.erl +++ b/lib/inets/test/httpd_1_1.erl @@ -370,18 +370,18 @@ validateRangeRequest2(Socket, Head, Body, ValidBody, BodySize) validateMultiPartRangeRequest(Body, ValidBody, Boundary)-> - case inets_regexp:split(Body,"--"++Boundary++"--") of + case re:split(Body,"--"++Boundary++"--", [{return, list}]) of %%Last is the epilogue and must be ignored - {ok,[First | _Last]}-> + [First | _Last]-> %%First is now the actuall http request body. - case inets_regexp:split(First, "--" ++ Boundary) of + case re:split(First, "--" ++ Boundary, [{return, list}]) of %%Parts is now a list of ranges and the heads for each range %%Gues we try to split out the body - {ok,Parts}-> + Parts-> case lists:flatten(lists:map(fun splitRange/1,Parts)) of ValidBody-> ok; - ParsedBody-> + ParsedBody-> error = ParsedBody end end; @@ -391,8 +391,8 @@ validateMultiPartRangeRequest(Body, ValidBody, Boundary)-> splitRange(Part)-> - case inets_regexp:split(Part, "\r\n\r\n") of - {ok,[_, Body]} -> + case re:split(Part, "\r\n\r\n", [{return, list}]) of + [_, Body] -> string:substr(Body, 1, length(Body) - 2); _ -> [] @@ -412,13 +412,13 @@ getRangeSize(Head)-> {multiPart, BoundaryString}-> {multiPart, BoundaryString}; _X1 -> - case inets_regexp:match(Head, ?CONTENT_RANGE "bytes=.*\r\n") of - {match, Start, Lenght} -> + case re:run(Head, ?CONTENT_RANGE "bytes=.*\r\n", [{capture, first}]) of + {match, [{Start, Lenght}]} -> %% Get the range data remove the fieldname and the %% end of line. - RangeInfo = string:substr(Head, Start + 20, - Lenght - (20 - 2)), - rangeSize(RangeInfo); + RangeInfo = string:substr(Head, Start + 1 + 20, + Lenght - (20 +2)), + rangeSize(string:strip(RangeInfo)); _X2 -> error end @@ -454,10 +454,10 @@ num(_CharVal, false) -> true. controlMimeType(Head)-> - case inets_regexp:match(Head,?CONTENT_TYPE "multipart/byteranges.*\r\n") of - {match,Start,Length}-> + case re:run(Head,?CONTENT_TYPE "multipart/byteranges.*\r\n", [{capture, first}]) of + {match, [{Start,Length}]}-> FieldNameLen = length(?CONTENT_TYPE "multipart/byteranges"), - case clearBoundary(string:substr(Head, Start + FieldNameLen, + case clearBoundary(string:substr(Head, Start + 1 + FieldNameLen, Length - (FieldNameLen+2))) of error -> error; @@ -471,10 +471,10 @@ controlMimeType(Head)-> end. clearBoundary(Boundary)-> - case inets_regexp:match(Boundary, "boundary=.*\$") of - {match, Start1, Length1}-> + case re:run(Boundary, "boundary=.*\$", [{capture, first}]) of + {match, [{Start1, Length1}]}-> BoundLen = length("boundary="), - string:substr(Boundary, Start1 + BoundLen, Length1 - BoundLen); + string:substr(Boundary, Start1 + 1 + BoundLen, Length1 - BoundLen); _ -> error end. @@ -489,12 +489,12 @@ end_of_header(HeaderPart) -> end. get_body_size(Head) -> - case inets_regexp:match(Head,?CONTENT_LENGTH ".*\r\n") of - {match, Start, Length} -> + case re:run(Head,?CONTENT_LENGTH ".*\r\n", [{capture, first}]) of + {match, [{Start, Length}]} -> %% 15 is length of Content-Length, %% 17 Is length of Content-Length and \r\ S = list_to_integer( - string:strip(string:substr(Head, Start + 15, Length-17))), + string:strip(string:substr(Head, Start +1 + 15, Length-17))), S; _-> 0 diff --git a/lib/inets/test/httpd_load.erl b/lib/inets/test/httpd_load.erl index 39c2280f23..fef693d818 100644 --- a/lib/inets/test/httpd_load.erl +++ b/lib/inets/test/httpd_load.erl @@ -21,8 +21,7 @@ -module(httpd_load). --include("test_server.hrl"). --include("test_server_line.hrl"). +-include_lib("common_test/include/ct.hrl"). %% General testcases bodies called from httpd_SUITE -export([load_test/5]). diff --git a/lib/inets/test/httpd_mod.erl b/lib/inets/test/httpd_mod.erl index 847586a903..016989a22e 100644 --- a/lib/inets/test/httpd_mod.erl +++ b/lib/inets/test/httpd_mod.erl @@ -21,8 +21,7 @@ -module(httpd_mod). --include("test_server.hrl"). --include("test_server_line.hrl"). +-include_lib("common_test/include/ct.hrl"). %% General testcases bodies called from httpd_SUITE -export([alias/4, actions/4, security/5, auth/4, auth_api/6, diff --git a/lib/inets/test/httpd_poll.erl b/lib/inets/test/httpd_poll.erl index aca7b70376..4a570fb512 100644 --- a/lib/inets/test/httpd_poll.erl +++ b/lib/inets/test/httpd_poll.erl @@ -259,11 +259,11 @@ validate(ExpStatusCode,Socket,Response) -> vtrace("validate -> Entry with ~p bytes response",[Sz]), Size = trash_the_rest(Socket,Sz), close(Socket), - case inets_regexp:split(Response," ") of - {ok,["HTTP/1.0",ExpStatusCode|_]} -> + case re:split(Response," ", [{return, list}]) of + ["HTTP/1.0",ExpStatusCode|_] -> vlog("response (~p bytes) was ok",[Size]), ok; - {ok,["HTTP/1.0",StatusCode|_]} -> + ["HTTP/1.0",StatusCode|_] -> verror("unexpected response status received: ~s => ~s", [StatusCode,status_to_message(StatusCode)]), log("unexpected result to GET of '~s': ~s => ~s", diff --git a/lib/inets/test/httpd_test_lib.erl b/lib/inets/test/httpd_test_lib.erl index c58966ce10..71e201f826 100644 --- a/lib/inets/test/httpd_test_lib.erl +++ b/lib/inets/test/httpd_test_lib.erl @@ -96,10 +96,10 @@ verify_request(SocketType, Host, Port, TranspOpts, Node, RequestStr, Options, Ti try inets_test_lib:connect_bin(SocketType, Host, Port, TranspOpts) of {ok, Socket} -> ok = inets_test_lib:send(SocketType, Socket, RequestStr), - State = case inets_regexp:match(RequestStr, "printenv") of + State = case re:run(RequestStr, "printenv", [{capture, none}]) of nomatch -> #state{}; - _ -> + match -> #state{print = true} end, @@ -317,10 +317,10 @@ do_validate(Header, [_Unknown | Rest], N, P) -> do_validate(Header, Rest, N, P). is_expect(RequestStr) -> - case inets_regexp:match(RequestStr, "xpect:100-continue") of - {match, _, _}-> + case re:run(RequestStr, "xpect:100-continue", [{capture, none}]) of + match-> true; - _ -> + nomatch -> false end. diff --git a/lib/inets/test/httpd_time_test.erl b/lib/inets/test/httpd_time_test.erl index 7c0acb5a99..1b4d74b28e 100644 --- a/lib/inets/test/httpd_time_test.erl +++ b/lib/inets/test/httpd_time_test.erl @@ -386,31 +386,31 @@ validate(ExpStatusCode, _SocketType, _Socket, Response) -> %% Sz = sz(Response), %% trash_the_rest(Socket, Sz), %% inets_test_lib:close(SocketType, Socket), - case inets_regexp:split(Response," ") of - {ok, ["HTTP/1.0", ExpStatusCode|_]} -> + case re:split(Response," ", [{return, list}]) of + ["HTTP/1.0", ExpStatusCode|_] -> ok; - {ok, ["HTTP/1.0", StatusCode|_]} -> + ["HTTP/1.0", StatusCode|_] -> error_msg("Unexpected status code: ~p (~s). " "Expected status code: ~p (~s)", [StatusCode, status_to_message(StatusCode), ExpStatusCode, status_to_message(ExpStatusCode)]), exit({unexpected_response_code, StatusCode, ExpStatusCode}); - {ok, ["HTTP/1.1", ExpStatusCode|_]} -> + ["HTTP/1.1", ExpStatusCode|_] -> ok; - {ok, ["HTTP/1.1", StatusCode|_]} -> + ["HTTP/1.1", StatusCode|_] -> error_msg("Unexpected status code: ~p (~s). " "Expected status code: ~p (~s)", [StatusCode, status_to_message(StatusCode), ExpStatusCode, status_to_message(ExpStatusCode)]), exit({unexpected_response_code, StatusCode, ExpStatusCode}); - {ok, Unexpected} -> - error_msg("Unexpected response split: ~p (~s)", - [Unexpected, Response]), - exit({unexpected_response, Unexpected, Response}); - {error, Reason} -> + {error, Reason} -> error_msg("Failed processing response: ~p (~s)", [Reason, Response]), - exit({failed_response_processing, Reason, Response}) + exit({failed_response_processing, Reason, Response}); + Unexpected -> + error_msg("Unexpected response split: ~p (~s)", + [Unexpected, Response]), + exit({unexpected_response, Unexpected, Response}) end. diff --git a/lib/inets/test/old_httpd_SUITE.erl b/lib/inets/test/old_httpd_SUITE.erl index aaaf69fbec..f972f0f435 100644 --- a/lib/inets/test/old_httpd_SUITE.erl +++ b/lib/inets/test/old_httpd_SUITE.erl @@ -21,8 +21,7 @@ -module(old_httpd_SUITE). --include_lib("test_server/include/test_server.hrl"). --include("test_server_line.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("inets_test_lib.hrl"). -include_lib("kernel/include/file.hrl"). diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index 2717f5b110..ee5f41aaec 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -19,6 +19,6 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 6.1 +INETS_VSN = 6.1.1 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" diff --git a/lib/jinterface/test/jinterface_SUITE.erl b/lib/jinterface/test/jinterface_SUITE.erl index 6d34a21209..5c4618dcde 100644 --- a/lib/jinterface/test/jinterface_SUITE.erl +++ b/lib/jinterface/test/jinterface_SUITE.erl @@ -46,7 +46,6 @@ ]). -include_lib("common_test/include/ct.hrl"). --include("test_server_line.hrl"). -define(debug,true). -ifdef(debug). diff --git a/lib/jinterface/test/nc_SUITE.erl b/lib/jinterface/test/nc_SUITE.erl index c5f3198c21..9910334749 100644 --- a/lib/jinterface/test/nc_SUITE.erl +++ b/lib/jinterface/test/nc_SUITE.erl @@ -21,7 +21,6 @@ -include_lib("common_test/include/ct.hrl"). --include("test_server_line.hrl"). -define(VERSION_MAGIC, 131). diff --git a/lib/kernel/doc/src/code.xml b/lib/kernel/doc/src/code.xml index eb0f4b7a06..d4c9a48901 100644 --- a/lib/kernel/doc/src/code.xml +++ b/lib/kernel/doc/src/code.xml @@ -101,30 +101,6 @@ </section> <section> - <title>Code Path Cache</title> - <p>The code server incorporates a code path cache. The cache - functionality is disabled by default. To activate it, start - the emulator with the command line flag <c>-code_path_cache</c> - or call <c>code:rehash()</c>. When the cache is created (or - updated), the code server searches for modules in the code path - directories. This may take some time if the the code path is long. - After the cache creation, the time for loading modules in a large - system (one with a large directory structure) is significantly - reduced compared to having the cache disabled. The code server - is able to look up the location of a module from the cache in - constant time instead of having to search through the code path - directories.</p> - <p>Application resource files (<c>.app</c> files) are also stored - in the code path cache. This feature is used by the application - controller (see - <seealso marker="application">application(3)</seealso>) to load - applications efficiently in large systems.</p> - <p>Note that when the code path cache is created (or updated), any - relative directory names in the code path are converted to - absolute.</p> - </section> - - <section> <title>Loading of Code From Archive Files</title> <warning><p>The support for loading of code from archive files is @@ -287,6 +263,46 @@ was given to <c>set_path/1</c>).</p> </section> + <section> + <marker id="error_reasons"></marker> + <title>Error Reasons for Code-Loading Functions</title> + + <p>Functions that load code (such as <c>load_file/1</c>) will + return <c>{error,Reason}</c> if the load operation fails. + Here follows a description of the common reasons.</p> + + <taglist> + <tag><c>badfile</c></tag> + <item> + <p>The object code has an incorrect format or the module + name in the object code is not the expected module name.</p> + </item> + + <tag><c>nofile</c></tag> + <item> + <p>No file with object code was found.</p> + </item> + + <tag><c>not_purged</c></tag> + <item> + <p>The object code could not be loaded because an old version + of the code already existed.</p> + </item> + + <tag><c>on_load_failure</c></tag> + <item> + <p>The module has an + <seealso marker="doc/reference_manual:code_loading#on_load">-on_load function</seealso> + that failed when it was called.</p> + </item> + + <tag><c>sticky_directory</c></tag> + <item> + <p>The object code resides in a sticky directory.</p> + </item> + + </taglist> + </section> <datatypes> <datatype> <name name="load_ret"/> @@ -411,12 +427,8 @@ be used to load object code with a module name that is different from the file name.</p> <p>Returns <c>{module, <anno>Module</anno>}</c> if successful, or - <c>{error, nofile}</c> if no object code is found, or - <c>{error, sticky_directory}</c> if the object code resides in - a sticky directory. Also if the loading fails, an error tuple is - returned. See - <seealso marker="erts:erlang#load_module/2">erlang:load_module/2</seealso> - for possible values of <c><anno>What</anno></c>.</p> + <c>{error, Reason}</c> if loading fails. + See <seealso marker="#error_reasons">Error Reasons for Code-Loading Functions</seealso> for a description of the possible error reasons.</p> </desc> </func> <func> @@ -428,7 +440,7 @@ <desc> <p>Does the same as <c>load_file(<anno>Module</anno>)</c>, but <c><anno>Filename</anno></c> is either an absolute file name, or a - relative file name. The code path is not searched. It returns + relative file name. The code path is not searched. It returns a value in the same way as <seealso marker="#load_file/1">load_file/1</seealso>. Note that <c><anno>Filename</anno></c> should not contain the extension (for @@ -444,7 +456,8 @@ <seealso marker="#load_file/1">load_file/1</seealso>, unless the module is already loaded. In embedded mode, however, it does not load a module which is not - already loaded, but returns <c>{error, embedded}</c> instead.</p> + already loaded, but returns <c>{error, embedded}</c> instead. + See <seealso marker="#error_reasons">Error Reasons for Code-Loading Functions</seealso> for a description of other possible error reasons.</p> </desc> </func> <func> @@ -461,12 +474,8 @@ comes. Accordingly, <c><anno>Filename</anno></c> is not opened and read by the code server.</p> <p>Returns <c>{module, <anno>Module</anno>}</c> if successful, or - <c>{error, sticky_directory}</c> if the object code resides in - a sticky directory, or <c>{error, badarg}</c> if any argument - is invalid. Also if the loading fails, an error tuple is - returned. See - <seealso marker="erts:erlang#load_module/2">erlang:load_module/2</seealso> - for possible values of <c><anno>What</anno></c>.</p> + <c>{error, Reason}</c> if loading fails. + See <seealso marker="#error_reasons">Error Reasons for Code-Loading Functions</seealso> for a description of the possible error reasons.</p> </desc> </func> <func> @@ -700,13 +709,6 @@ rpc:call(Node, code, load_binary, [Module, Filename, Binary]), </desc> </func> <func> - <name name="rehash" arity="0"/> - <fsummary>Rehash or create code path cache</fsummary> - <desc> - <p>This function creates or rehashes the code path cache.</p> - </desc> - </func> - <func> <name name="where_is_file" arity="1"/> <fsummary>Full name of a file located in the code path</fsummary> <desc> @@ -714,10 +716,7 @@ rpc:call(Node, code, load_binary, [Module, Filename, Binary]), arbitrary type. If found, the full name is returned. <c>non_existing</c> is returned if the file cannot be found. The function can be useful, for example, to locate - application resource files. If the code path cache is used, - the code server will efficiently read the full name from - the cache, provided that <c><anno>Filename</anno></c> is an object code - file or an <c>.app</c> file.</p> + application resource files.</p> </desc> </func> <func> diff --git a/lib/kernel/doc/src/net_kernel.xml b/lib/kernel/doc/src/net_kernel.xml index a0132db8db..311e0d8ea4 100644 --- a/lib/kernel/doc/src/net_kernel.xml +++ b/lib/kernel/doc/src/net_kernel.xml @@ -63,11 +63,16 @@ <funcs> <func> <name name="allow" arity="1"/> - <fsummary>Limit access to a specified set of nodes</fsummary> + <fsummary>Permit access to a specified set of nodes</fsummary> <desc> - <p>Limits access to the specified set of nodes. Any access - attempts made from (or to) nodes not in <c><anno>Nodes</anno></c> will be - rejected.</p> + <p>Permits access to the specified set of nodes.</p> + <p>Before the first call to <c>allow/1</c>, any node with the correct + cookie can be connected. When <c>allow/1</c> is called, a list + of allowed nodes is established. Any access attempts made from (or to) + nodes not in that list will be rejected.</p> + <p>Subsequent calls to <c>allow/1</c> will add the specified nodes + to the list of allowed nodes. It is not possible to remove nodes + from the list.</p> <p>Returns <c>error</c> if any element in <c><anno>Nodes</anno></c> is not an atom.</p> </desc> diff --git a/lib/kernel/doc/src/notes.xml b/lib/kernel/doc/src/notes.xml index 5341a793ef..b625ddba5d 100644 --- a/lib/kernel/doc/src/notes.xml +++ b/lib/kernel/doc/src/notes.xml @@ -529,8 +529,7 @@ Erlang/OTP has been ported to the realtime operating system OSE. The port supports both smp and non-smp emulator. For details around the port and how to started - see the User's Guide in the <seealso - marker="ose:ose_intro">ose</seealso> application. </p> + see the User's Guide in the ose application. </p> <p> Note that not all parts of Erlang/OTP has been ported. </p> <p> diff --git a/lib/kernel/doc/src/os.xml b/lib/kernel/doc/src/os.xml index 682d4a2eac..165160a909 100644 --- a/lib/kernel/doc/src/os.xml +++ b/lib/kernel/doc/src/os.xml @@ -37,6 +37,7 @@ use these functions can be of help in enabling a program to run on most platforms.</p> </description> + <funcs> <func> <name name="cmd" arity="1"/> @@ -210,6 +211,30 @@ format_utc_timestamp() -> </desc> </func> <func> + <name name="perf_counter" arity="0"/> + <fsummary>Returns a performance counter</fsummary> + <desc> + <p>Returns the current performance counter value in <c>perf_counter</c> + <seealso marker="erts:erlang#type_time_unit">time unit</seealso>. + This is a highly optimized call that might not be traceable. + </p> + </desc> + </func> + <func> + <name name="perf_counter" arity="1"/> + <fsummary>Returns a performance counter</fsummary> + <desc><p>Returns a performance counter that can be used as a very fast and + high resolution timestamp. This counter is read directly from the hardware or operating + system with the same guarantees. This means that two consecutive calls + to the function are not guaranteed to be monotonic, though it most likely will be. + The performance counter till be converted to the resolution passed as an argument.</p> + <pre>1> <input>T1 = os:perf_counter(1000),receive after 10000 -> ok end,T2 = os:perf_counter(1000).</input> +176525861 +2> <input>T2 - T1.</input> +10004</pre> + </desc> + </func> + <func> <name name="type" arity="0"/> <fsummary>Return the OS family and, in some cases, OS name of the current operating system</fsummary> <desc> diff --git a/lib/kernel/doc/src/ref_man.xml.src b/lib/kernel/doc/src/ref_man.xml.src deleted file mode 100644 index 7eb48a5f1d..0000000000 --- a/lib/kernel/doc/src/ref_man.xml.src +++ /dev/null @@ -1,68 +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>2013</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>Kernel Reference Manual</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - </header> - <description> - <p>The <em>Kernel</em> application has all the code necessary to run - the Erlang runtime system itself: file servers and code servers - and so on.</p> - </description> - <xi:include href="kernel_app.xml"/> - <xi:include href="application.xml"/> - <xi:include href="auth.xml"/> - <xi:include href="code.xml"/> - <xi:include href="disk_log.xml"/> - <xi:include href="erl_boot_server.xml"/> - <xi:include href="erl_ddll.xml"/> - <xi:include href="erl_prim_loader_stub.xml"/> - <xi:include href="erlang_stub.xml"/> - <xi:include href="error_handler.xml"/> - <xi:include href="error_logger.xml"/> - <xi:include href="file.xml"/> - <xi:include href="gen_tcp.xml"/> - <xi:include href="gen_udp.xml"/> - <xi:include href="gen_sctp.xml"/> - <xi:include href="global.xml"/> - <xi:include href="global_group.xml"/> - <xi:include href="heart.xml"/> - <xi:include href="inet.xml"/> - <xi:include href="inet_res.xml"/> - <xi:include href="init_stub.xml"/> - <xi:include href="net_adm.xml"/> - <xi:include href="net_kernel.xml"/> - <xi:include href="os.xml"/> - <xi:include href="pg2.xml"/> - <xi:include href="rpc.xml"/> - <xi:include href="seq_trace.xml"/> - <xi:include href="user.xml"/> - <xi:include href="wrap_log_reader.xml"/> - <xi:include href="zlib_stub.xml"/> - <xi:include href="app.xml"/> - <xi:include href="config.xml"/> -</application> diff --git a/lib/kernel/doc/src/seq_trace.xml b/lib/kernel/doc/src/seq_trace.xml index 3439111035..f4fcd222ec 100644 --- a/lib/kernel/doc/src/seq_trace.xml +++ b/lib/kernel/doc/src/seq_trace.xml @@ -127,6 +127,35 @@ seq_trace:set_token(OldToken), % activate the trace token again enables/disables a timestamp to be generated for each traced event. Default is <c>false</c>.</p> </item> + <tag><c>set_token(strict_monotonic_timestamp, <anno>Bool</anno>)</c></tag> + <item> + <p>A trace token flag (<c>true | false</c>) which + enables/disables a strict monotonic timestamp to be generated + for each traced event. Default is <c>false</c>. Timestamps will + consist of + <seealso marker="erts:time_correction#Erlang_Monotonic_Time">Erlang + monotonic time</seealso> and a monotonically increasing + integer. The time-stamp has the same format and value + as produced by <c>{erlang:monotonic_time(nano_seconds), + erlang:unique_integer([monotonic])}</c>.</p> + </item> + <tag><c>set_token(monotonic_timestamp, <anno>Bool</anno>)</c></tag> + <item> + <p>A trace token flag (<c>true | false</c>) which + enables/disables a strict monotonic timestamp to be generated + for each traced event. Default is <c>false</c>. Timestamps + will use + <seealso marker="erts:time_correction#Erlang_Monotonic_Time">Erlang + monotonic time</seealso>. The time-stamp has the same + format and value as produced by + <c>erlang:monotonic_time(nano_seconds)</c>.</p> + </item> + <p>If multiple timestamp flags are passed, <c>timestamp</c> has + precedence over <c>strict_monotonic_timestamp</c> which + in turn has precedence over <c>monotonic_timestamp</c>. All + timestamp flags are remembered, so if two are passed + and the one with highest precedence later is disabled + the other one will become active.</p> </taglist> </desc> </func> diff --git a/lib/kernel/include/file.hrl b/lib/kernel/include/file.hrl index 7cf033f7f5..36112bb040 100644 --- a/lib/kernel/include/file.hrl +++ b/lib/kernel/include/file.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2015. 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,37 +23,40 @@ %%-------------------------------------------------------------------------- -record(file_info, - {size :: non_neg_integer(), % Size of file in bytes. - type :: 'device' | 'directory' | 'other' | 'regular' | 'symlink', - access :: 'read' | 'write' | 'read_write' | 'none', - atime :: file:date_time() | non_neg_integer(), + {size :: non_neg_integer() | 'undefined', % Size of file in bytes. + type :: 'device' | 'directory' | 'other' | 'regular' | 'symlink' + | 'undefined', + access :: 'read' | 'write' | 'read_write' | 'none' | 'undefined', + atime :: file:date_time() | non_neg_integer() | 'undefined', % The local time the file was last read: % {{Year, Mon, Day}, {Hour, Min, Sec}}. % atime, ctime, mtime may also be unix epochs() - mtime :: file:date_time() | non_neg_integer(), + mtime :: file:date_time() | non_neg_integer() | 'undefined', % The local time the file was last written. - ctime :: file:date_time() | non_neg_integer(), + ctime :: file:date_time() | non_neg_integer() | 'undefined', % The interpretation of this time field % is dependent on operating system. % On Unix it is the last time the file % or the inode was changed. On Windows, % it is the creation time. - mode :: non_neg_integer(), % File permissions. On Windows, + mode :: non_neg_integer() | 'undefined', + % File permissions. On Windows, % the owner permissions will be % duplicated for group and user. - links :: non_neg_integer(), + links :: non_neg_integer() | 'undefined', % Number of links to the file (1 if the % filesystem doesn't support links). - major_device :: non_neg_integer(), + major_device :: non_neg_integer() | 'undefined', % Identifies the file system (Unix), % or the drive number (A: = 0, B: = 1) % (Windows). %% The following are Unix specific. %% They are set to zero on other operating systems. - minor_device :: non_neg_integer(), % Only valid for devices. - inode :: non_neg_integer(), % Inode number for file. - uid :: non_neg_integer(), % User id for owner. - gid :: non_neg_integer()}). % Group id for owner. + minor_device :: non_neg_integer() | 'undefined', + % Only valid for devices. + inode :: non_neg_integer() | 'undefined', % Inode number for file. + uid :: non_neg_integer() | 'undefined', % User id for owner. + gid :: non_neg_integer() | 'undefined'}). % Group id for owner. -record(file_descriptor, diff --git a/lib/kernel/src/code.erl b/lib/kernel/src/code.erl index 352c02562b..59e226df43 100644 --- a/lib/kernel/src/code.erl +++ b/lib/kernel/src/code.erl @@ -60,7 +60,7 @@ del_path/1, replace_path/2, rehash/0, - start_link/0, start_link/1, + start_link/0, which/1, where_is_file/1, where_is_file/2, @@ -68,6 +68,8 @@ clash/0, get_mode/0]). +-deprecated({rehash,0,next_major_release}). + -export_type([load_error_rsn/0, load_ret/0]). -include_lib("kernel/include/file.hrl"). @@ -77,10 +79,9 @@ %%---------------------------------------------------------------------------- -type load_error_rsn() :: 'badfile' - | 'native_code' | 'nofile' | 'not_purged' - | 'on_load' + | 'on_load_failure' | 'sticky_directory'. -type load_ret() :: {'error', What :: load_error_rsn()} | {'module', Module :: module()}. @@ -135,14 +136,16 @@ load_file(Mod) when is_atom(Mod) -> -spec ensure_loaded(Module) -> {module, Module} | {error, What} when Module :: module(), - What :: embedded | badfile | native_code | nofile | on_load. + What :: embedded | badfile | nofile | on_load_failure. ensure_loaded(Mod) when is_atom(Mod) -> call({ensure_loaded,Mod}). %% XXX File as an atom is allowed only for backwards compatibility. -spec load_abs(Filename) -> load_ret() when Filename :: file:filename(). -load_abs(File) when is_list(File); is_atom(File) -> call({load_abs,File,[]}). +load_abs(File) when is_list(File); is_atom(File) -> + Mod = list_to_atom(filename:basename(File)), + call({load_abs,File,Mod}). %% XXX Filename is also an atom(), e.g. 'cover_compiled' -spec load_abs(Filename :: loaded_filename(), Module :: module()) -> load_ret(). @@ -293,7 +296,9 @@ replace_path(Name, Dir) when (is_atom(Name) orelse is_list(Name)), call({replace_path,Name,Dir}). -spec rehash() -> 'ok'. -rehash() -> call(rehash). +rehash() -> + cache_warning(), + ok. -spec get_mode() -> 'embedded' | 'interactive'. get_mode() -> call(get_mode). @@ -301,15 +306,11 @@ get_mode() -> call(get_mode). %%----------------------------------------------------------------- call(Req) -> - code_server:call(code_server, Req). + code_server:call(Req). -spec start_link() -> {'ok', pid()} | {'error', 'crash'}. start_link() -> - start_link([stick]). - --spec start_link(Flags :: [atom()]) -> {'ok', pid()} | {'error', 'crash'}. -start_link(Flags) -> - do_start(Flags). + do_start(). %%----------------------------------------------------------------- %% In the init phase, code must not use any modules not yet loaded, @@ -321,35 +322,21 @@ start_link(Flags) -> %% us, so the module is loaded. %%----------------------------------------------------------------- -do_start(Flags) -> +do_start() -> + maybe_warn_for_cache(), load_code_server_prerequisites(), - Mode = get_mode(Flags), - case init:get_argument(root) of - {ok,[[Root0]]} -> - Root = filename:join([Root0]), % Normalize. Use filename - case code_server:start_link([Root,Mode]) of - {ok,_Pid} = Ok2 -> - if - Mode =:= interactive -> - case lists:member(stick, Flags) of - true -> do_stick_dirs(); - _ -> ok - end; - true -> - ok - end, - %% Quietly load native code for all modules loaded so far - Architecture = erlang:system_info(hipe_architecture), - load_native_code_for_all_loaded(Architecture), - Ok2; - Other -> - Other - end; - Other -> - error_logger:error_msg("Can not start code server ~w ~n", [Other]), - {error, crash} - end. + {ok,[[Root0]]} = init:get_argument(root), + Mode = start_get_mode(), + Root = filename:join([Root0]), % Normalize. + Res = code_server:start_link([Root,Mode]), + + maybe_stick_dirs(Mode), + + %% Quietly load native code for all modules loaded so far. + Architecture = erlang:system_info(hipe_architecture), + load_native_code_for_all_loaded(Architecture), + Res. %% Make sure that all modules that the code_server process calls %% (directly or indirectly) are loaded. Otherwise the code_server @@ -369,6 +356,16 @@ load_code_server_prerequisites() -> _ = [M = M:module_info(module) || M <- Needed], ok. +maybe_stick_dirs(interactive) -> + case init:get_argument(nostick) of + {ok,[[]]} -> + ok; + _ -> + do_stick_dirs() + end; +maybe_stick_dirs(_) -> + ok. + do_stick_dirs() -> do_s(compiler), do_s(stdlib), @@ -386,19 +383,12 @@ do_s(Lib) -> ok end. -get_mode(Flags) -> - case lists:member(embedded, Flags) of - true -> +start_get_mode() -> + case init:get_argument(mode) of + {ok,[["embedded"]]} -> embedded; - _Otherwise -> - case init:get_argument(mode) of - {ok,[["embedded"]]} -> - embedded; - {ok,[["minimal"]]} -> - minimal; - _Else -> - interactive - end + _ -> + interactive end. %% Find out which version of a particular module we would @@ -452,30 +442,14 @@ which(File, Base, [Directory|Tail]) -> Filename :: file:filename(), Absname :: file:filename(). where_is_file(File) when is_list(File) -> - case call({is_cached,File}) of - no -> - Path = get_path(), - which(File, ".", Path); - Dir -> - filename:join(Dir, File) - end. + Path = get_path(), + which(File, ".", Path). -spec where_is_file(Path :: file:filename(), Filename :: file:filename()) -> file:filename() | 'non_existing'. where_is_file(Path, File) when is_list(Path), is_list(File) -> - CodePath = get_path(), - if - Path =:= CodePath -> - case call({is_cached, File}) of - no -> - which(File, ".", Path); - Dir -> - filename:join(Dir, File) - end; - true -> - which(File, ".", Path) - end. + which(File, ".", Path). -spec set_primary_archive(ArchiveFile :: file:filename(), ArchiveBin :: binary(), @@ -553,6 +527,22 @@ has_ext(Ext, Extlen, File) -> end. %%% +%%% Warning for deprecated code path cache. +%%% + +maybe_warn_for_cache() -> + case init:get_argument(code_path_cache) of + {ok, _} -> + cache_warning(); + error -> + ok + end. + +cache_warning() -> + W = "The code path cache functionality has been removed", + error_logger:warning_report(W). + +%%% %%% Silently load native code for all modules loaded so far. %%% diff --git a/lib/kernel/src/code_server.erl b/lib/kernel/src/code_server.erl index e461c95d19..b52def8777 100644 --- a/lib/kernel/src/code_server.erl +++ b/lib/kernel/src/code_server.erl @@ -22,9 +22,7 @@ %% This file holds the server part of the code_server. -export([start_link/1, - call/2, - system_continue/3, - system_terminate/4, + call/1, system_code_change/4, error_msg/2, info_msg/2 ]). @@ -35,16 +33,18 @@ -define(ANY_NATIVE_CODE_LOADED, any_native_code_loaded). --record(state, {supervisor, - root, - path, - moddb, - namedb, - cache = no_cache, - mode = interactive, - on_load = []}). +-type on_load_item() :: {reference(),module(),file:name_all(),[pid()]}. + +-record(state, {supervisor :: pid(), + root :: file:name_all(), + path :: [file:name_all()], + moddb :: ets:tab(), + namedb :: ets:tab(), + mode = interactive :: 'interactive' | 'embedded', + on_load = [] :: [on_load_item()]}). -type state() :: #state{}. +-spec start_link([term()]) -> {'ok', pid()}. start_link(Args) -> Ref = make_ref(), Parent = self(), @@ -59,7 +59,7 @@ start_link(Args) -> %% Init the code_server process. %% ----------------------------------------------------------- -init(Ref, Parent, [Root,Mode0]) -> +init(Ref, Parent, [Root,Mode]) -> register(?MODULE, self()), process_flag(trap_exit, true), @@ -70,12 +70,6 @@ init(Ref, Parent, [Root,Mode0]) -> end, erlang:pre_loaded()), ets:insert(Db, init:fetch_loaded()), - Mode = - case Mode0 of - minimal -> interactive; - _ -> Mode0 - end, - IPath = case Mode of interactive -> @@ -89,24 +83,17 @@ init(Ref, Parent, [Root,Mode0]) -> end, Path = add_loader_path(IPath, Mode), - State0 = #state{root = Root, - path = Path, - moddb = Db, - namedb = init_namedb(Path), - mode = Mode}, - - State = - case init:get_argument(code_path_cache) of - {ok, _} -> - create_cache(State0); - error -> - State0 - end, + State = #state{supervisor = Parent, + root = Root, + path = Path, + moddb = Db, + namedb = init_namedb(Path), + mode = Mode}, put(?ANY_NATIVE_CODE_LOADED, false), Parent ! {Ref,{ok,self()}}, - loop(State#state{supervisor = Parent}). + loop(State). get_user_lib_dirs() -> case os:getenv("ERL_LIBS") of @@ -142,8 +129,9 @@ split_paths([C|T], S, Path, Paths) -> split_paths([], _S, Path, Paths) -> lists:reverse(Paths, [lists:reverse(Path)]). -call(Name, Req) -> - Name ! {code_call, self(), Req}, +-spec call(term()) -> term(). +call(Req) -> + ?MODULE ! {code_call, self(), Req}, receive {?MODULE, Reply} -> Reply @@ -255,65 +243,39 @@ handle_call({dir,Dir}, {_From,_Tag}, S) -> Resp = do_dir(Root,Dir,S#state.namedb), {reply,Resp,S}; -handle_call({load_file,Mod}, Caller, St) -> - case modp(Mod) of - false -> - {reply,{error,badarg},St}; - true -> - load_file(Mod, Caller, St) - end; +handle_call({load_file,Mod}, Caller, St) when is_atom(Mod) -> + load_file(Mod, Caller, St); handle_call({add_path,Where,Dir0}, {_From,_Tag}, - #state{cache=Cache0,namedb=Namedb,path=Path0}=S) -> - case Cache0 of - no_cache -> - {Resp,Path} = add_path(Where, Dir0, Path0, Namedb), - {reply,Resp,S#state{path=Path}}; - _ -> - Dir = absname(Dir0), %% Cache always expands the path - {Resp,Path} = add_path(Where, Dir, Path0, Namedb), - Cache = update_cache([Dir], Where, Cache0), - {reply,Resp,S#state{path=Path,cache=Cache}} - end; + #state{namedb=Namedb,path=Path0}=S) -> + {Resp,Path} = add_path(Where, Dir0, Path0, Namedb), + {reply,Resp,S#state{path=Path}}; handle_call({add_paths,Where,Dirs0}, {_From,_Tag}, - #state{cache=Cache0,namedb=Namedb,path=Path0}=S) -> - case Cache0 of - no_cache -> - {Resp,Path} = add_paths(Where, Dirs0, Path0, Namedb), - {reply,Resp,S#state{path=Path}}; - _ -> - %% Cache always expands the path - Dirs = [absname(Dir) || Dir <- Dirs0], - {Resp,Path} = add_paths(Where, Dirs, Path0, Namedb), - Cache=update_cache(Dirs,Where,Cache0), - {reply,Resp,S#state{cache=Cache,path=Path}} - end; + #state{namedb=Namedb,path=Path0}=S) -> + {Resp,Path} = add_paths(Where, Dirs0, Path0, Namedb), + {reply,Resp,S#state{path=Path}}; handle_call({set_path,PathList}, {_From,_Tag}, #state{path=Path0,namedb=Namedb}=S) -> {Resp,Path,NewDb} = set_path(PathList, Path0, Namedb), - {reply,Resp,rehash_cache(S#state{path=Path,namedb=NewDb})}; + {reply,Resp,S#state{path=Path,namedb=NewDb}}; handle_call({del_path,Name}, {_From,_Tag}, #state{path=Path0,namedb=Namedb}=S) -> {Resp,Path} = del_path(Name, Path0, Namedb), - {reply,Resp,rehash_cache(S#state{path=Path})}; + {reply,Resp,S#state{path=Path}}; handle_call({replace_path,Name,Dir}, {_From,_Tag}, #state{path=Path0,namedb=Namedb}=S) -> {Resp,Path} = replace_path(Name, Dir, Path0, Namedb), - {reply,Resp,rehash_cache(S#state{path=Path})}; - -handle_call(rehash, {_From,_Tag}, S0) -> - S = create_cache(S0), - {reply,ok,S}; + {reply,Resp,S#state{path=Path}}; handle_call(get_path, {_From,_Tag}, S) -> {reply,S#state.path,S}; %% Messages to load, delete and purge modules/files. -handle_call({load_abs,File,Mod}, Caller, S) -> +handle_call({load_abs,File,Mod}, Caller, S) when is_atom(Mod) -> case modp(File) of false -> {reply,{error,badarg},S}; @@ -321,7 +283,7 @@ handle_call({load_abs,File,Mod}, Caller, S) -> load_abs(File, Mod, Caller, S) end; -handle_call({load_binary,Mod,File,Bin}, Caller, S) -> +handle_call({load_binary,Mod,File,Bin}, Caller, S) when is_atom(Mod) -> do_load_binary(Mod, File, Bin, Caller, S); handle_call({load_native_partial,Mod,Bin}, {_From,_Tag}, S) -> @@ -337,59 +299,44 @@ handle_call({load_native_sticky,Mod,Bin,WholeModule}, {_From,_Tag}, S) -> Status = hipe_result_to_status(Result), {reply,Status,S}; -handle_call({ensure_loaded,Mod0}, Caller, St0) -> - Fun = fun (M, St) -> - case erlang:module_loaded(M) of - true -> - {reply,{module,M},St}; - false when St#state.mode =:= interactive -> - load_file(M, Caller, St); - false -> - {reply,{error,embedded},St} - end - end, - do_mod_call(Fun, Mod0, {error,badarg}, St0); - -handle_call({delete,Mod0}, {_From,_Tag}, S) -> - Fun = fun (M, St) -> - case catch erlang:delete_module(M) of - true -> - ets:delete(St#state.moddb, M), - {reply,true,St}; - _ -> - {reply,false,St} - end - end, - do_mod_call(Fun, Mod0, false, S); +handle_call({ensure_loaded,Mod}, Caller, St) when is_atom(Mod) -> + case erlang:module_loaded(Mod) of + true -> + {reply,{module,Mod},St}; + false when St#state.mode =:= interactive -> + load_file(Mod, Caller, St); + false -> + {reply,{error,embedded},St} + end; + +handle_call({delete,Mod}, {_From,_Tag}, St) when is_atom(Mod) -> + case catch erlang:delete_module(Mod) of + true -> + ets:delete(St#state.moddb, Mod), + {reply,true,St}; + _ -> + {reply,false,St} + end; -handle_call({purge,Mod0}, {_From,_Tag}, St0) -> - do_mod_call(fun (M, St) -> - {reply,do_purge(M),St} - end, Mod0, false, St0); +handle_call({purge,Mod}, {_From,_Tag}, St) when is_atom(Mod) -> + {reply,do_purge(Mod),St}; -handle_call({soft_purge,Mod0}, {_From,_Tag}, St0) -> - do_mod_call(fun (M, St) -> - {reply,do_soft_purge(M),St} - end, Mod0, true, St0); +handle_call({soft_purge,Mod}, {_From,_Tag}, St) when is_atom(Mod) -> + {reply,do_soft_purge(Mod),St}; -handle_call({is_loaded,Mod0}, {_From,_Tag}, St0) -> - do_mod_call(fun (M, St) -> - {reply,is_loaded(M, St#state.moddb),St} - end, Mod0, false, St0); +handle_call({is_loaded,Mod}, {_From,_Tag}, St) when is_atom(Mod) -> + {reply,is_loaded(Mod, St#state.moddb),St}; handle_call(all_loaded, {_From,_Tag}, S) -> Db = S#state.moddb, {reply,all_loaded(Db),S}; -handle_call({get_object_code,Mod0}, {_From,_Tag}, St0) -> - Fun = fun(M, St) -> - Path = St#state.path, - case mod_to_bin(Path, atom_to_list(M)) of - {_,Bin,FName} -> {reply,{M,Bin,FName},St}; - Error -> {reply,Error,St} - end - end, - do_mod_call(Fun, Mod0, error, St0); +handle_call({get_object_code,Mod}, {_From,_Tag}, St) when is_atom(Mod) -> + Path = St#state.path, + case mod_to_bin(Path, Mod) of + {_,Bin,FName} -> {reply,{Mod,Bin,FName},St}; + Error -> {reply,Error,St} + end; handle_call({is_sticky, Mod}, {_From,_Tag}, S) -> Db = S#state.moddb, @@ -398,9 +345,6 @@ handle_call({is_sticky, Mod}, {_From,_Tag}, S) -> handle_call(stop,{_From,_Tag}, S) -> {stop,normal,stopped,S}; -handle_call({is_cached,_File}, {_From,_Tag}, S=#state{cache=no_cache}) -> - {reply, no, S}; - handle_call({set_primary_archive, File, ArchiveBin, FileInfo, ParserFun}, {_From,_Tag}, S=#state{mode=Mode}) -> case erl_prim_loader:set_primary_archive(File, ArchiveBin, FileInfo, ParserFun) of {ok, Files} -> @@ -409,26 +353,6 @@ handle_call({set_primary_archive, File, ArchiveBin, FileInfo, ParserFun}, {_From {reply, Error, S} end; -handle_call({is_cached,File}, {_From,_Tag}, S=#state{cache=Cache}) -> - ObjExt = objfile_extension(), - Ext = filename:extension(File), - Type = case Ext of - ObjExt -> obj; - ".app" -> app; - _ -> undef - end, - if Type =:= undef -> - {reply, no, S}; - true -> - Key = {Type,list_to_atom(filename:rootname(File, Ext))}, - case ets:lookup(Cache, Key) of - [] -> - {reply, no, S}; - [{Key,Dir}] -> - {reply, Dir, S} - end - end; - handle_call(get_mode, {_From,_Tag}, S=#state{mode=Mode}) -> {reply, Mode, S}; @@ -436,80 +360,6 @@ handle_call(Other,{_From,_Tag}, S) -> error_msg(" ** Codeserver*** ignoring ~w~n ",[Other]), {noreply,S}. -do_mod_call(Action, Module, _Error, St) when is_atom(Module) -> - Action(Module, St); -do_mod_call(Action, Module, Error, St) -> - try list_to_atom(Module) of - Atom when is_atom(Atom) -> - Action(Atom, St) - catch - error:badarg -> - {reply,Error,St} - end. - -%% -------------------------------------------------------------- -%% Cache functions -%% -------------------------------------------------------------- - -create_cache(St = #state{cache = no_cache}) -> - Cache = ets:new(code_cache, [protected]), - rehash_cache(Cache, St); -create_cache(St) -> - rehash_cache(St). - -rehash_cache(St = #state{cache = no_cache}) -> - St; -rehash_cache(St = #state{cache = OldCache}) -> - ets:delete(OldCache), - Cache = ets:new(code_cache, [protected]), - rehash_cache(Cache, St). - -rehash_cache(Cache, St = #state{path = Path}) -> - Exts = [{obj,objfile_extension()}, {app,".app"}], - {Cache,NewPath} = locate_mods(lists:reverse(Path), first, Exts, Cache, []), - St#state{cache = Cache, path=NewPath}. - -update_cache(Dirs, Where, Cache0) -> - Exts = [{obj,objfile_extension()}, {app,".app"}], - {Cache, _} = locate_mods(Dirs, Where, Exts, Cache0, []), - Cache. - -locate_mods([Dir0|Path], Where, Exts, Cache, Acc) -> - Dir = absname(Dir0), %% Cache always expands the path - case erl_prim_loader:list_dir(Dir) of - {ok, Files} -> - Cache = filter_mods(Files, Where, Exts, Dir, Cache), - locate_mods(Path, Where, Exts, Cache, [Dir|Acc]); - error -> - locate_mods(Path, Where, Exts, Cache, Acc) - end; -locate_mods([], _, _, Cache, Path) -> - {Cache,Path}. - -filter_mods([File|Rest], Where, Exts, Dir, Cache) -> - Ext = filename:extension(File), - Root = list_to_atom(filename:rootname(File, Ext)), - case lists:keyfind(Ext, 2, Exts) of - {Type, _} -> - Key = {Type,Root}, - case Where of - first -> - true = ets:insert(Cache, {Key,Dir}); - last -> - case ets:lookup(Cache, Key) of - [] -> - true = ets:insert(Cache, {Key,Dir}); - _ -> - ignore - end - end; - false -> - ok - end, - filter_mods(Rest, Where, Exts, Dir, Cache); -filter_mods([], _, _, _, Cache) -> - Cache. - %% -------------------------------------------------------------- %% Path handling functions. %% -------------------------------------------------------------- @@ -1207,9 +1057,9 @@ add_paths(_,_,Path,_) -> {ok,Path}. do_load_binary(Module, File, Binary, Caller, St) -> - case modp(Module) andalso modp(File) andalso is_binary(Binary) of + case modp(File) andalso is_binary(Binary) of true -> - case erlang:module_loaded(to_atom(Module)) of + case erlang:module_loaded(Module) of true -> do_purge(Module); false -> ok end, @@ -1222,15 +1072,10 @@ modp(Atom) when is_atom(Atom) -> true; modp(List) when is_list(List) -> int_list(List); modp(_) -> false. -load_abs(File, Mod0, Caller, St) -> +load_abs(File, Mod, Caller, St) -> Ext = objfile_extension(), FileName0 = lists:concat([File, Ext]), FileName = absname(FileName0), - Mod = if Mod0 =:= [] -> - list_to_atom(filename:basename(FileName0, Ext)); - true -> - Mod0 - end, case erl_prim_loader:get_file(FileName) of {ok,Bin,_} -> try_load_module(FileName, Mod, Bin, Caller, St); @@ -1238,21 +1083,10 @@ load_abs(File, Mod0, Caller, St) -> {reply,{error,nofile},St} end. -try_load_module(Mod, Dir, Caller, St) -> - File = filename:append(Dir, to_list(Mod) ++ - objfile_extension()), - case erl_prim_loader:get_file(File) of - error -> - {reply,error,St}; - {ok,Binary,FName} -> - try_load_module(absname(FName), Mod, Binary, Caller, St) - end. - try_load_module(File, Mod, Bin, {From,_}=Caller, St0) -> - M = to_atom(Mod), - case pending_on_load(M, From, St0) of + case pending_on_load(Mod, From, St0) of no -> - try_load_module_1(File, M, Bin, Caller, St0); + try_load_module_1(File, Mod, Bin, Caller, St0); {yes,St} -> {noreply,St} end. @@ -1271,9 +1105,10 @@ try_load_module_2(File, Mod, Bin, Caller, undefined, St) -> try_load_module_3(File, Mod, Bin, Caller, undefined, St); try_load_module_2(File, Mod, Bin, Caller, Architecture, #state{moddb=Db}=St) -> - case catch load_native_code(Mod, Bin, Architecture) of + case catch hipe_unified_loader:load_native_code(Mod, Bin, Architecture) of {module,Mod} = Module -> - ets:insert(Db, {Mod,File}), + put(?ANY_NATIVE_CODE_LOADED, true), + ets:insert(Db, {Mod,File}), {reply,Module,St}; no_native -> try_load_module_3(File, Mod, Bin, Caller, Architecture, St); @@ -1296,26 +1131,6 @@ try_load_module_3(File, Mod, Bin, Caller, Architecture, {reply,Error,St} end. -load_native_code(Mod, Bin, Architecture) -> - %% During bootstrapping of Open Source Erlang, we don't have any hipe - %% loader modules, but the Erlang emulator might be hipe enabled. - %% Therefore we must test for that the loader modules are available - %% before trying to to load native code. - case erlang:module_loaded(hipe_unified_loader) of - false -> - no_native; - true -> - Result = hipe_unified_loader:load_native_code(Mod, Bin, - Architecture), - case Result of - {module,_} -> - put(?ANY_NATIVE_CODE_LOADED, true); - _ -> - ok - end, - Result - end. - hipe_result_to_status(Result) -> case Result of {module,_} -> @@ -1338,37 +1153,22 @@ int_list([H|T]) when is_integer(H) -> int_list(T); int_list([_|_]) -> false; int_list([]) -> true. -load_file(Mod0, {From,_}=Caller, St0) -> - Mod = to_atom(Mod0), +load_file(Mod, {From,_}=Caller, St0) -> case pending_on_load(Mod, From, St0) of no -> load_file_1(Mod, Caller, St0); {yes,St} -> {noreply,St} end. -load_file_1(Mod, Caller, #state{path=Path,cache=no_cache}=St) -> +load_file_1(Mod, Caller, #state{path=Path}=St) -> case mod_to_bin(Path, Mod) of error -> {reply,{error,nofile},St}; {Mod,Binary,File} -> - try_load_module(File, Mod, Binary, Caller, St) - end; -load_file_1(Mod, Caller, #state{cache=Cache}=St0) -> - Key = {obj,Mod}, - case ets:lookup(Cache, Key) of - [] -> - St = rehash_cache(St0), - case ets:lookup(St#state.cache, Key) of - [] -> - {reply,{error,nofile},St}; - [{Key,Dir}] -> - try_load_module(Mod, Dir, Caller, St) - end; - [{Key,Dir}] -> - try_load_module(Mod, Dir, Caller, St0) + try_load_module_1(File, Mod, Binary, Caller, St) end. mod_to_bin([Dir|Tail], Mod) -> - File = filename:append(Dir, to_list(Mod) ++ objfile_extension()), + File = filename:append(Dir, atom_to_list(Mod) ++ objfile_extension()), case erl_prim_loader:get_file(File) of error -> mod_to_bin(Tail, Mod); @@ -1421,243 +1221,6 @@ absname_vr([[X, $:]|Name], _, _AbsBase) -> absname(filename:join(Name), Dcwd). -%% do_purge(Module) -%% Kill all processes running code from *old* Module, and then purge the -%% module. Return true if any processes killed, else false. - -do_purge(Mod0) -> - Mod = to_atom(Mod0), - case erlang:check_old_code(Mod) of - false -> - false; - true -> - Res = check_proc_code(erlang:processes(), Mod, true), - try - erlang:purge_module(Mod) - catch - _:_ -> ignore - end, - Res - end. - -%% do_soft_purge(Module) -%% Purge old code only if no procs remain that run old code. -%% Return true in that case, false if procs remain (in this -%% case old code is not purged) - -do_soft_purge(Mod0) -> - Mod = to_atom(Mod0), - case erlang:check_old_code(Mod) of - false -> - true; - true -> - case check_proc_code(erlang:processes(), Mod, false) of - false -> - false; - true -> - try - erlang:purge_module(Mod) - catch - _:_ -> ignore - end, - true - end - end. - -%% -%% check_proc_code(Pids, Mod, Hard) - Send asynchronous -%% requests to all processes to perform a check_process_code -%% operation. Each process will check their own state and -%% reply with the result. If 'Hard' equals -%% - true, processes that refer 'Mod' will be killed. If -%% any processes were killed true is returned; otherwise, -%% false. -%% - false, and any processes refer 'Mod', false will -%% returned; otherwise, true. -%% -%% Requests will be sent to all processes identified by -%% Pids at once, but without allowing GC to be performed. -%% Check process code operations that are aborted due to -%% GC need, will be restarted allowing GC. However, only -%% ?MAX_CPC_GC_PROCS outstanding operation allowing GC at -%% a time will be allowed. This in order not to blow up -%% memory wise. -%% -%% We also only allow ?MAX_CPC_NO_OUTSTANDING_KILLS -%% outstanding kills. This both in order to avoid flooding -%% our message queue with 'DOWN' messages and limiting the -%% amount of memory used to keep references to all -%% outstanding kills. -%% - -%% We maybe should allow more than two outstanding -%% GC requests, but for now we play it safe... --define(MAX_CPC_GC_PROCS, 2). --define(MAX_CPC_NO_OUTSTANDING_KILLS, 10). - --record(cpc_static, {hard, module, tag}). - --record(cpc_kill, {outstanding = [], - no_outstanding = 0, - waiting = [], - killed = false}). - -check_proc_code(Pids, Mod, Hard) -> - Tag = erlang:make_ref(), - CpcS = #cpc_static{hard = Hard, - module = Mod, - tag = Tag}, - check_proc_code(CpcS, cpc_init(CpcS, Pids, 0), 0, [], #cpc_kill{}, true). - -check_proc_code(#cpc_static{hard = true}, 0, 0, [], - #cpc_kill{outstanding = [], waiting = [], killed = Killed}, - true) -> - %% No outstanding requests. We did a hard check, so result is whether or - %% not we killed any processes... - Killed; -check_proc_code(#cpc_static{hard = false}, 0, 0, [], _KillState, Success) -> - %% No outstanding requests and we did a soft check... - Success; -check_proc_code(#cpc_static{hard = false, tag = Tag} = CpcS, NoReq0, NoGcReq0, - [], _KillState, false) -> - %% Failed soft check; just cleanup the remaining replies corresponding - %% to the requests we've sent... - {NoReq1, NoGcReq1} = receive - {check_process_code, {Tag, _P, GC}, _Res} -> - case GC of - false -> {NoReq0-1, NoGcReq0}; - true -> {NoReq0, NoGcReq0-1} - end - end, - check_proc_code(CpcS, NoReq1, NoGcReq1, [], _KillState, false); -check_proc_code(#cpc_static{tag = Tag} = CpcS, NoReq0, NoGcReq0, NeedGC0, - KillState0, Success) -> - - %% Check if we should request a GC operation - {NoGcReq1, NeedGC1} = case NoGcReq0 < ?MAX_CPC_GC_PROCS of - GcOpAllowed when GcOpAllowed == false; - NeedGC0 == [] -> - {NoGcReq0, NeedGC0}; - _ -> - {NoGcReq0+1, cpc_request_gc(CpcS,NeedGC0)} - end, - - %% Wait for a cpc reply or 'DOWN' message - {NoReq1, NoGcReq2, Pid, Result, KillState1} = cpc_recv(Tag, - NoReq0, - NoGcReq1, - KillState0), - - %% Check the result of the reply - case Result of - aborted -> - %% Operation aborted due to the need to GC in order to - %% determine if the process is referring the module. - %% Schedule the operation for restart allowing GC... - check_proc_code(CpcS, NoReq1, NoGcReq2, [Pid|NeedGC1], KillState1, - Success); - false -> - %% Process not referring the module; done with this process... - check_proc_code(CpcS, NoReq1, NoGcReq2, NeedGC1, KillState1, - Success); - true -> - %% Process referring the module... - case CpcS#cpc_static.hard of - false -> - %% ... and soft check. The whole operation failed so - %% no point continuing; clean up and fail... - check_proc_code(CpcS, NoReq1, NoGcReq2, [], KillState1, - false); - true -> - %% ... and hard check; schedule kill of it... - check_proc_code(CpcS, NoReq1, NoGcReq2, NeedGC1, - cpc_sched_kill(Pid, KillState1), Success) - end; - 'DOWN' -> - %% Handled 'DOWN' message - check_proc_code(CpcS, NoReq1, NoGcReq2, NeedGC1, - KillState1, Success) - end. - -cpc_recv(Tag, NoReq, NoGcReq, #cpc_kill{outstanding = []} = KillState) -> - receive - {check_process_code, {Tag, Pid, GC}, Res} -> - cpc_handle_cpc(NoReq, NoGcReq, GC, Pid, Res, KillState) - end; -cpc_recv(Tag, NoReq, NoGcReq, - #cpc_kill{outstanding = [R0, R1, R2, R3, R4 | _]} = KillState) -> - receive - {'DOWN', R, process, _, _} when R == R0; - R == R1; - R == R2; - R == R3; - R == R4 -> - cpc_handle_down(NoReq, NoGcReq, R, KillState); - {check_process_code, {Tag, Pid, GC}, Res} -> - cpc_handle_cpc(NoReq, NoGcReq, GC, Pid, Res, KillState) - end; -cpc_recv(Tag, NoReq, NoGcReq, #cpc_kill{outstanding = [R|_]} = KillState) -> - receive - {'DOWN', R, process, _, _} -> - cpc_handle_down(NoReq, NoGcReq, R, KillState); - {check_process_code, {Tag, Pid, GC}, Res} -> - cpc_handle_cpc(NoReq, NoGcReq, GC, Pid, Res, KillState) - end. - -cpc_handle_down(NoReq, NoGcReq, R, #cpc_kill{outstanding = Rs, - no_outstanding = N} = KillState) -> - {NoReq, NoGcReq, undefined, 'DOWN', - cpc_sched_kill_waiting(KillState#cpc_kill{outstanding = cpc_list_rm(R, Rs), - no_outstanding = N-1})}. - -cpc_list_rm(R, [R|Rs]) -> - Rs; -cpc_list_rm(R0, [R1|Rs]) -> - [R1|cpc_list_rm(R0, Rs)]. - -cpc_handle_cpc(NoReq, NoGcReq, false, Pid, Res, KillState) -> - {NoReq-1, NoGcReq, Pid, Res, KillState}; -cpc_handle_cpc(NoReq, NoGcReq, true, Pid, Res, KillState) -> - {NoReq, NoGcReq-1, Pid, Res, KillState}. - -cpc_sched_kill_waiting(#cpc_kill{waiting = []} = KillState) -> - KillState; -cpc_sched_kill_waiting(#cpc_kill{outstanding = Rs, - no_outstanding = N, - waiting = [P|Ps]} = KillState) -> - R = erlang:monitor(process, P), - exit(P, kill), - KillState#cpc_kill{outstanding = [R|Rs], - no_outstanding = N+1, - waiting = Ps, - killed = true}. - -cpc_sched_kill(Pid, #cpc_kill{no_outstanding = N, waiting = Pids} = KillState) - when N >= ?MAX_CPC_NO_OUTSTANDING_KILLS -> - KillState#cpc_kill{waiting = [Pid|Pids]}; -cpc_sched_kill(Pid, - #cpc_kill{outstanding = Rs, no_outstanding = N} = KillState) -> - R = erlang:monitor(process, Pid), - exit(Pid, kill), - KillState#cpc_kill{outstanding = [R|Rs], - no_outstanding = N+1, - killed = true}. - -cpc_request(#cpc_static{tag = Tag, module = Mod}, Pid, AllowGc) -> - erlang:check_process_code(Pid, Mod, [{async, {Tag, Pid, AllowGc}}, - {allow_gc, AllowGc}]). - -cpc_request_gc(CpcS, [Pid|Pids]) -> - cpc_request(CpcS, Pid, true), - Pids. - -cpc_init(_CpcS, [], NoReqs) -> - NoReqs; -cpc_init(CpcS, [Pid|Pids], NoReqs) -> - cpc_request(CpcS, Pid, false), - cpc_init(CpcS, Pids, NoReqs+1). - -% end of check_proc_code() implementation. is_loaded(M, Db) -> case ets:lookup(Db, M) of @@ -1665,6 +1228,14 @@ is_loaded(M, Db) -> [] -> false end. +do_purge(Mod) -> + {_WasOld, DidKill} = erts_code_purger:purge(Mod), + DidKill. + +do_soft_purge(Mod) -> + erts_code_purger:soft_purge(Mod). + + %% ------------------------------------------------------- %% The on_load functionality. %% ------------------------------------------------------- @@ -1759,13 +1330,13 @@ strip_mod_info([{{sticky,_},_}|T], Acc) -> strip_mod_info(T, Acc); strip_mod_info([H|T], Acc) -> strip_mod_info(T, [H|Acc]); strip_mod_info([], Acc) -> Acc. -% error_msg(Format) -> -% error_msg(Format,[]). +-spec error_msg(io:format(), [term()]) -> 'ok'. error_msg(Format, Args) -> Msg = {notify,{error, group_leader(), {self(), Format, Args}}}, error_logger ! Msg, ok. +-spec info_msg(io:format(), [term()]) -> 'ok'. info_msg(Format, Args) -> Msg = {notify,{info_msg, group_leader(), {self(), Format, Args}}}, error_logger ! Msg, @@ -1779,6 +1350,3 @@ archive_extension() -> to_list(X) when is_list(X) -> X; to_list(X) when is_atom(X) -> atom_to_list(X). - -to_atom(X) when is_atom(X) -> X; -to_atom(X) when is_list(X) -> list_to_atom(X). diff --git a/lib/kernel/src/disk_log.erl b/lib/kernel/src/disk_log.erl index f5450f30af..9b44021872 100644 --- a/lib/kernel/src/disk_log.erl +++ b/lib/kernel/src/disk_log.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2015. 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. @@ -1310,13 +1310,20 @@ compare_arg(_Attr, _Val, _A) -> %% -> {ok, Res, log(), Cnt} | Error do_open(A) -> - L = #log{name = A#arg.name, - filename = A#arg.file, - size = A#arg.size, - head = mk_head(A#arg.head, A#arg.format), - mode = A#arg.mode, - version = A#arg.version}, - do_open2(L, A). + #arg{type = Type, format = Format, name = Name, head = Head0, + file = FName, repair = Repair, size = Size, mode = Mode, + version = V} = A, + Head = mk_head(Head0, Format), + case do_open2(Type, Format, Name, FName, Repair, Size, Mode, Head, V) of + {ok, Ret, Extra, FormatType, NoItems} -> + L = #log{name = Name, type = Type, format = Format, + filename = FName, size = Size, + format_type = FormatType, head = Head, mode = Mode, + version = V, extra = Extra}, + {ok, Ret, L, NoItems}; + Error -> + Error + end. mk_head({head, Term}, internal) -> {ok, term_to_binary(Term)}; mk_head({head, Bytes}, external) -> {ok, check_bytes(Bytes)}; @@ -1432,57 +1439,44 @@ do_inc_wrap_file(L) -> %%----------------------------------------------------------------- %% -> {ok, Reply, log(), Cnt} | Error %% Note: the header is always written, even if the log size is too small. -do_open2(L, #arg{type = halt, format = internal, name = Name, - file = FName, repair = Repair, size = Size, mode = Mode}) -> - case catch disk_log_1:int_open(FName, Repair, Mode, L#log.head) of +do_open2(halt, internal, Name, FName, Repair, Size, Mode, Head, _V) -> + case catch disk_log_1:int_open(FName, Repair, Mode, Head) of {ok, {_Alloc, FdC, {NoItems, _NoBytes}, FileSize}} -> Halt = #halt{fdc = FdC, curB = FileSize, size = Size}, - {ok, {ok, Name}, L#log{format_type = halt_int, extra = Halt}, - NoItems}; + {ok, {ok, Name}, Halt, halt_int, NoItems}; {repaired, FdC, Rec, Bad, FileSize} -> Halt = #halt{fdc = FdC, curB = FileSize, size = Size}, {ok, {repaired, Name, {recovered, Rec}, {badbytes, Bad}}, - L#log{format_type = halt_int, extra = Halt}, - Rec}; + Halt, halt_int, Rec}; Error -> Error end; -do_open2(L, #arg{type = wrap, format = internal, size = {MaxB, MaxF}, - name = Name, repair = Repair, file = FName, mode = Mode, - version = V}) -> +do_open2(wrap, internal, Name, FName, Repair, Size, Mode, Head, V) -> + {MaxB, MaxF} = Size, case catch - disk_log_1:mf_int_open(FName, MaxB, MaxF, Repair, Mode, L#log.head, V) of + disk_log_1:mf_int_open(FName, MaxB, MaxF, Repair, Mode, Head, V) of {ok, Handle, Cnt} -> - {ok, {ok, Name}, L#log{type = wrap, - format_type = wrap_int, - extra = Handle}, Cnt}; + {ok, {ok, Name}, Handle, wrap_int, Cnt}; {repaired, Handle, Rec, Bad, Cnt} -> {ok, {repaired, Name, {recovered, Rec}, {badbytes, Bad}}, - L#log{type = wrap, format_type = wrap_int, extra = Handle}, Cnt}; + Handle, wrap_int, Cnt}; Error -> Error end; -do_open2(L, #arg{type = halt, format = external, file = FName, name = Name, - size = Size, repair = Repair, mode = Mode}) -> - case catch disk_log_1:ext_open(FName, Repair, Mode, L#log.head) of +do_open2(halt, external, Name, FName, Repair, Size, Mode, Head, _V) -> + case catch disk_log_1:ext_open(FName, Repair, Mode, Head) of {ok, {_Alloc, FdC, {NoItems, _NoBytes}, FileSize}} -> Halt = #halt{fdc = FdC, curB = FileSize, size = Size}, - {ok, {ok, Name}, - L#log{format_type = halt_ext, format = external, extra = Halt}, - NoItems}; + {ok, {ok, Name}, Halt, halt_ext, NoItems}; Error -> Error end; -do_open2(L, #arg{type = wrap, format = external, size = {MaxB, MaxF}, - name = Name, file = FName, repair = Repair, mode = Mode, - version = V}) -> +do_open2(wrap, external, Name, FName, Repair, Size, Mode, Head, V) -> + {MaxB, MaxF} = Size, case catch - disk_log_1:mf_ext_open(FName, MaxB, MaxF, Repair, Mode, L#log.head, V) of + disk_log_1:mf_ext_open(FName, MaxB, MaxF, Repair, Mode, Head, V) of {ok, Handle, Cnt} -> - {ok, {ok, Name}, L#log{type = wrap, - format_type = wrap_ext, - extra = Handle, - format = external}, Cnt}; + {ok, {ok, Name}, Handle, wrap_ext, Cnt}; Error -> Error end. diff --git a/lib/kernel/src/disk_log.hrl b/lib/kernel/src/disk_log.hrl index 6c0aea070f..3262d979ee 100644 --- a/lib/kernel/src/disk_log.hrl +++ b/lib/kernel/src/disk_log.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% Copyright Ericsson AB 1997-2015. 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. @@ -152,8 +152,8 @@ users = 0 :: non_neg_integer(), %% non-linked users filename :: file:filename(), %% real name of the file owners = [] :: [{pid(), boolean()}],%% [{pid, notify}] - type = halt :: dlog_type(), - format = internal :: dlog_format(), + type :: dlog_type(), + format :: dlog_format(), format_type :: dlog_format_type(), head = none, %% none | {head, H} | {M,F,A} %% called when wraplog wraps diff --git a/lib/kernel/src/disk_log_1.erl b/lib/kernel/src/disk_log_1.erl index 9b9fd086f1..2e61363aa6 100644 --- a/lib/kernel/src/disk_log_1.erl +++ b/lib/kernel/src/disk_log_1.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% 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. @@ -79,6 +79,7 @@ log(FdC, FileName, X) -> logl(X) -> logl(X, [], 0). +-dialyzer({no_improper_lists, logl/3}). logl([X | T], Bs, Size) -> Sz = byte_size(X), BSz = <<Sz:?SIZESZ/unit:8>>, @@ -1142,6 +1143,7 @@ write_index_file(read_write, FName, NewFile, OldFile, OldCnt) -> file_error(FileName, E) end. +-dialyzer({no_improper_lists, to_8_bytes/4}). to_8_bytes(<<N:32,T/binary>>, NT, FileName, Fd) -> to_8_bytes(T, [NT | <<N:64>>], FileName, Fd); to_8_bytes(B, NT, _FileName, _Fd) when byte_size(B) =:= 0 -> @@ -1276,6 +1278,7 @@ ext_split_bins(CurB, MaxB, FirstPos, Bins) -> MaxBs = MaxB - CurB, IsFirst = CurB =:= FirstPos, ext_split_bins(MaxBs, IsFirst, [], Bins, 0, 0). +-dialyzer({no_improper_lists, ext_split_bins/6}). ext_split_bins(MaxBs, IsFirst, First, [X | Last], Bs, N) -> NBs = Bs + byte_size(X), if @@ -1296,6 +1299,7 @@ int_split_bins(CurB, MaxB, FirstPos, Bins) -> MaxBs = MaxB - CurB, IsFirst = CurB =:= FirstPos, int_split_bins(MaxBs, IsFirst, [], Bins, 0, 0). +-dialyzer({no_improper_lists, int_split_bins/6}). int_split_bins(MaxBs, IsFirst, First, [X | Last], Bs, N) -> Sz = byte_size(X), NBs = Bs + Sz + ?HEADERSZ, diff --git a/lib/kernel/src/error_logger.erl b/lib/kernel/src/error_logger.erl index eb231fd155..30a9457bb3 100644 --- a/lib/kernel/src/error_logger.erl +++ b/lib/kernel/src/error_logger.erl @@ -435,5 +435,82 @@ add_node(X, Pid) -> %% Can't do io_lib:format -display2(Tag,F,A) -> - erlang:display({error_logger,Tag,F,A}). +display2({{_Y,_Mo,_D},{_H,_Mi,_S}} = Date, F, A) -> + display_date(Date), + display3(string_p(F), F, A). + +display_date({{Y,Mo,D},{H,Mi,S}}) -> + erlang:display_string( + integer_to_list(Y) ++ "-" ++ + two_digits(Mo) ++ "-" ++ + two_digits(D) ++ " " ++ + two_digits(H) ++ ":" ++ + two_digits(Mi) ++ ":" ++ + two_digits(S) ++ " "). + +two_digits(N) when 0 =< N, N =< 9 -> + [$0, $0 + N]; +two_digits(N) -> + integer_to_list(N). + +display3(true, F, A) -> + %% Format string with arguments + erlang:display_string(F ++ "\n"), + [begin + erlang:display_string("\t"), + erlang:display(Arg) + end || Arg <- A], + ok; +display3(false, Atom, A) when is_atom(Atom) -> + %% The widest atom seems to be 'supervisor_report' at 17. + ColumnWidth = 20, + AtomString = atom_to_list(Atom), + AtomLength = length(AtomString), + Padding = lists:duplicate(ColumnWidth - AtomLength, $\s), + erlang:display_string(AtomString ++ Padding), + display4(A); +display3(_, F, A) -> + erlang:display({F, A}). + +display4([A, []]) -> + %% Not sure why crash reports look like this. + display4(A); +display4(A = [_|_]) -> + case lists:all(fun({Key,_Value}) -> is_atom(Key); (_) -> false end, A) of + true -> + erlang:display_string("\n"), + lists:foreach( + fun({Key, Value}) -> + erlang:display_string( + " " ++ + atom_to_list(Key) ++ + ": "), + erlang:display(Value) + end, A); + false -> + erlang:display(A) + end; +display4(A) -> + erlang:display(A). + +string_p([]) -> + false; +string_p(Term) -> + string_p1(Term). + +string_p1([H|T]) when is_integer(H), H >= $\s, H < 255 -> + string_p1(T); +string_p1([$\n|T]) -> string_p1(T); +string_p1([$\r|T]) -> string_p1(T); +string_p1([$\t|T]) -> string_p1(T); +string_p1([$\v|T]) -> string_p1(T); +string_p1([$\b|T]) -> string_p1(T); +string_p1([$\f|T]) -> string_p1(T); +string_p1([$\e|T]) -> string_p1(T); +string_p1([H|T]) when is_list(H) -> + case string_p1(H) of + true -> string_p1(T); + _ -> false + end; +string_p1([]) -> true; +string_p1(_) -> false. diff --git a/lib/kernel/src/erts_debug.erl b/lib/kernel/src/erts_debug.erl index 39308c0043..8e2b5ad214 100644 --- a/lib/kernel/src/erts_debug.erl +++ b/lib/kernel/src/erts_debug.erl @@ -34,7 +34,8 @@ -export([breakpoint/2, disassemble/1, display/1, dist_ext_to_term/2, dump_monitors/1, dump_links/1, flat_size/1, get_internal_state/1, instructions/0, lock_counters/1, - map_info/1, same/2, set_internal_state/2]). + map_info/1, same/2, set_internal_state/2, + size_shared/1, copy_shared/1]). -spec breakpoint(MFA, Flag) -> non_neg_integer() when MFA :: {Module :: module(), @@ -86,6 +87,18 @@ dump_links(_) -> flat_size(_) -> erlang:nif_error(undef). +-spec size_shared(Term) -> non_neg_integer() when + Term :: term(). + +size_shared(_) -> + erlang:nif_error(undef). + +-spec copy_shared(Term) -> term() when + Term :: term(). + +copy_shared(_) -> + erlang:nif_error(undef). + -spec get_internal_state(W) -> term() when W :: reds_left | node_and_dist_references | monitoring_nodes | next_pid | 'DbTable_words' | check_io_debug @@ -230,7 +243,7 @@ map_size(Map,Seen0,Sum0) -> %% is not allowed to leak anywhere. They are only allowed in %% containers (cons cells and tuples, not maps), in gc and %% in erts_debug:same/2 - case erts_internal:map_type(Map) of + case erts_internal:term_type(Map) of flatmap -> Kt = erts_internal:map_to_tuple_keys(Map), Vs = maps:values(Map), diff --git a/lib/kernel/src/global.erl b/lib/kernel/src/global.erl index 2be1efaf24..0c73ead7c5 100644 --- a/lib/kernel/src/global.erl +++ b/lib/kernel/src/global.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2015. 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. @@ -459,17 +459,17 @@ init([]) -> no_trace end, + Ca = case init:get_argument(connect_all) of + {ok, [["false"]]} -> + false; + _ -> + true + end, S = #state{the_locker = start_the_locker(DoTrace), trace = T0, - the_registrar = start_the_registrar()}, - S1 = trace_message(S, {init, node()}, []), - - case init:get_argument(connect_all) of - {ok, [["false"]]} -> - {ok, S1#state{connect_all = false}}; - _ -> - {ok, S1#state{connect_all = true}} - end. + the_registrar = start_the_registrar(), + connect_all = Ca}, + {ok, trace_message(S, {init, node()}, [])}. %%----------------------------------------------------------------- %% Connection algorithm @@ -2068,23 +2068,17 @@ get_known() -> gen_server:call(global_name_server, get_known, infinity). random_sleep(Times) -> - case (Times rem 10) of - 0 -> erase(random_seed); - _ -> ok - end, - case get(random_seed) of - undefined -> - _ = random:seed(erlang:phash2([erlang:node()]), - erlang:monotonic_time(), - erlang:unique_integer()), - ok; - _ -> ok - end, + _ = case Times rem 10 of + 0 -> + _ = rand:seed(exsplus); + _ -> + ok + end, %% First time 1/4 seconds, then doubling each time up to 8 seconds max. Tmax = if Times > 5 -> 8000; true -> ((1 bsl Times) * 1000) div 8 end, - T = random:uniform(Tmax), + T = rand:uniform(Tmax), ?trace({random_sleep, {me,self()}, {times,Times}, {t,T}, {tmax,Tmax}}), receive after T -> ok end. diff --git a/lib/kernel/src/global_group.erl b/lib/kernel/src/global_group.erl index 848df13c39..e71f83f9d3 100644 --- a/lib/kernel/src/global_group.erl +++ b/lib/kernel/src/global_group.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2013. All Rights Reserved. +%% Copyright Ericsson AB 1998-2015. 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. @@ -273,7 +273,7 @@ init([]) -> {ok, #state{publish_type = PT, group_publish_type = PubTpGrp, sync_state = synced, group_name = DefGroupName, no_contact = lists:sort(DefNodes), - other_grps = DefOther}} + other_grps = DefOther, connect_all = Ca}} end. diff --git a/lib/kernel/src/heart.erl b/lib/kernel/src/heart.erl index 464b6919f1..137fad706f 100644 --- a/lib/kernel/src/heart.erl +++ b/lib/kernel/src/heart.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. 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. @@ -265,6 +265,7 @@ do_cycle_port_program(Caller, Parent, Port, Cmd) -> send_heart_beat(Port) -> Port ! {self(), {command, [?HEART_BEAT]}}. %% Set a new HEART_COMMAND. +-dialyzer({no_improper_lists, send_heart_cmd/2}). send_heart_cmd(Port, []) -> Port ! {self(), {command, [?CLEAR_CMD]}}; send_heart_cmd(Port, Cmd) -> diff --git a/lib/kernel/src/inet.erl b/lib/kernel/src/inet.erl index b573112445..c1ae99ea24 100644 --- a/lib/kernel/src/inet.erl +++ b/lib/kernel/src/inet.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2015. All Rights Reserved. +%% 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. @@ -289,7 +289,7 @@ getifaddrs(Socket) -> -spec getifaddrs() -> {ok, Iflist} | {error, posix()} when Iflist :: [{Ifname,[Ifopt]}], Ifname :: string(), - Ifopt :: {flag,[Flag]} | {addr,Addr} | {netmask,Netmask} + Ifopt :: {flags,[Flag]} | {addr,Addr} | {netmask,Netmask} | {broadaddr,Broadaddr} | {dstaddr,Dstaddr} | {hwaddr,Hwaddr}, Flag :: up | broadcast | loopback | pointtopoint diff --git a/lib/kernel/src/inet_config.erl b/lib/kernel/src/inet_config.erl index 803fae846e..a0d5344f11 100644 --- a/lib/kernel/src/inet_config.erl +++ b/lib/kernel/src/inet_config.erl @@ -188,9 +188,6 @@ do_load_resolv({win32,Type}, longnames) -> win32_load_from_registry(Type), inet_db:set_lookup([native]); -do_load_resolv({ose,_}, _) -> - inet_db:set_lookup([file]); - do_load_resolv(_, _) -> inet_db:set_lookup([native]). diff --git a/lib/kernel/src/kernel.app.src b/lib/kernel/src/kernel.app.src index b5555ca1a5..419dc0a2fc 100644 --- a/lib/kernel/src/kernel.app.src +++ b/lib/kernel/src/kernel.app.src @@ -116,6 +116,6 @@ {applications, []}, {env, [{error_logger, tty}]}, {mod, {kernel, []}}, - {runtime_dependencies, ["erts-7.0", "stdlib-2.6", "sasl-2.6"]} + {runtime_dependencies, ["erts-7.3", "stdlib-2.6", "sasl-2.6"]} ] }. diff --git a/lib/kernel/src/kernel.erl b/lib/kernel/src/kernel.erl index 5f33f25a0d..40544da6c3 100644 --- a/lib/kernel/src/kernel.erl +++ b/lib/kernel/src/kernel.erl @@ -98,7 +98,7 @@ init([]) -> {kernel_config, start_link, []}, permanent, 2000, worker, [kernel_config]}, Code = {code_server, - {code, start_link, get_code_args()}, + {code, start_link, []}, permanent, 2000, worker, [code]}, File = {file_server_2, {file_server, start_link, []}, @@ -158,12 +158,6 @@ init(safe) -> {ok, {SupFlags, Boot ++ DiskLog ++ Pg2}}. -get_code_args() -> - case init:get_argument(nostick) of - {ok, [[]]} -> [[nostick]]; - _ -> [] - end. - start_dist_ac() -> Spec = [{dist_ac,{dist_ac,start_link,[]},permanent,2000,worker,[dist_ac]}], case application:get_env(kernel, start_dist_ac) of diff --git a/lib/kernel/src/os.erl b/lib/kernel/src/os.erl index 3330b38d84..4947088635 100644 --- a/lib/kernel/src/os.erl +++ b/lib/kernel/src/os.erl @@ -27,7 +27,9 @@ %%% BIFs --export([getenv/0, getenv/1, getenv/2, getpid/0, putenv/2, system_time/0, system_time/1, +-export([getenv/0, getenv/1, getenv/2, getpid/0, + perf_counter/0, perf_counter/1, + putenv/2, system_time/0, system_time/1, timestamp/0, unsetenv/1]). -spec getenv() -> [string()]. @@ -60,6 +62,18 @@ getenv(VarName, DefaultValue) -> getpid() -> erlang:nif_error(undef). +-spec perf_counter() -> Counter when + Counter :: integer(). + +perf_counter() -> + erlang:nif_error(undef). + +-spec perf_counter(Unit) -> integer() when + Unit :: erlang:time_unit(). + +perf_counter(Unit) -> + erlang:convert_time_unit(os:perf_counter(), perf_counter, Unit). + -spec putenv(VarName, Value) -> true when VarName :: string(), Value :: string(). @@ -93,7 +107,7 @@ unsetenv(_) -> %%% End of BIFs -spec type() -> {Osfamily, Osname} when - Osfamily :: unix | win32 | ose, + Osfamily :: unix | win32, Osname :: atom(). type() -> @@ -212,174 +226,33 @@ extensions() -> Command :: atom() | io_lib:chars(). cmd(Cmd) -> validate(Cmd), - Bytes = case type() of - {unix, _} -> - unix_cmd(Cmd); - {win32, Wtype} -> - Command0 = case {os:getenv("COMSPEC"),Wtype} of - {false,windows} -> lists:concat(["command.com /c", Cmd]); - {false,_} -> lists:concat(["cmd /c", Cmd]); - {Cspec,_} -> lists:concat([Cspec," /c",Cmd]) - end, - %% open_port/2 awaits string() in Command, but io_lib:chars() can be - %% deep lists according to io_lib module description. - Command = lists:flatten(Command0), - Port = open_port({spawn, Command}, [stream, in, eof, hide]), - get_data(Port, []) - end, - String = unicode:characters_to_list(list_to_binary(Bytes)), + {SpawnCmd, SpawnOpts, SpawnInput} = mk_cmd(os:type(), Cmd), + Port = open_port({spawn, SpawnCmd}, [binary, stderr_to_stdout, + stream, in, eof, hide | SpawnOpts]), + true = port_command(Port, SpawnInput), + Bytes = get_data(Port, []), + String = unicode:characters_to_list(Bytes), if %% Convert to unicode list if possible otherwise return bytes is_list(String) -> String; - true -> Bytes - end. - -unix_cmd(Cmd) -> - Tag = make_ref(), - {Pid,Mref} = erlang:spawn_monitor( - fun() -> - process_flag(trap_exit, true), - Port = start_port(), - erlang:port_command(Port, mk_cmd(Cmd)), - exit({Tag,unix_get_data(Port)}) - end), - receive - {'DOWN',Mref,_,Pid,{Tag,Result}} -> - Result; - {'DOWN',Mref,_,Pid,Reason} -> - exit(Reason) + true -> binary_to_list(Bytes) end. -%% The -s flag implies that only the positional parameters are set, -%% and the commands are read from standard input. We set the -%% $1 parameter for easy identification of the resident shell. -%% --define(ROOT, "/"). --define(ROOT_ANDROID, "/system"). --define(SHELL, "bin/sh -s unix:cmd 2>&1"). --define(PORT_CREATOR_NAME, os_cmd_port_creator). - -%% -%% Serializing open_port through a process to avoid smp lock contention -%% when many concurrent os:cmd() want to do vfork (OTP-7890). -%% --spec start_port() -> port(). -start_port() -> - Ref = make_ref(), - Request = {Ref,self()}, - {Pid, Mon} = case whereis(?PORT_CREATOR_NAME) of - undefined -> - spawn_monitor(fun() -> - start_port_srv(Request) - end); - P -> - P ! Request, - M = erlang:monitor(process, P), - {P, M} - end, - receive - {Ref, Port} when is_port(Port) -> - erlang:demonitor(Mon, [flush]), - Port; - {Ref, Error} -> - erlang:demonitor(Mon, [flush]), - exit(Error); - {'DOWN', Mon, process, Pid, _Reason} -> - start_port() - end. - -start_port_srv(Request) -> - %% We don't want a group leader of some random application. Use - %% kernel_sup's group leader. - {group_leader, GL} = process_info(whereis(kernel_sup), - group_leader), - true = group_leader(GL, self()), - process_flag(trap_exit, true), - StayAlive = try register(?PORT_CREATOR_NAME, self()) - catch - error:_ -> false - end, - start_port_srv_handle(Request), - case StayAlive of - true -> start_port_srv_loop(); - false -> exiting - end. - -start_port_srv_handle({Ref,Client}) -> - Path = case lists:reverse(erlang:system_info(system_architecture)) of - % androideabi - "ibaediordna" ++ _ -> filename:join([?ROOT_ANDROID, ?SHELL]); - _ -> filename:join([?ROOT, ?SHELL]) - end, - Reply = try open_port({spawn, Path},[stream]) of - Port when is_port(Port) -> - (catch port_connect(Port, Client)), - unlink(Port), - Port - catch - error:Reason -> - {Reason,erlang:get_stacktrace()} - end, - Client ! {Ref,Reply}, - ok. - -start_port_srv_loop() -> - receive - {Ref, Client} = Request when is_reference(Ref), - is_pid(Client) -> - start_port_srv_handle(Request); - _Junk -> - ok - end, - start_port_srv_loop(). - -%% -%% unix_get_data(Port) -> Result -%% -unix_get_data(Port) -> - unix_get_data(Port, []). - -unix_get_data(Port, Sofar) -> - receive - {Port,{data, Bytes}} -> - case eot(Bytes) of - {done, Last} -> - lists:flatten([Sofar|Last]); - more -> - unix_get_data(Port, [Sofar|Bytes]) - end; - {'EXIT', Port, _} -> - lists:flatten(Sofar) - end. - -%% -%% eot(String) -> more | {done, Result} -%% -eot(Bs) -> - eot(Bs, []). - -eot([4| _Bs], As) -> - {done, lists:reverse(As)}; -eot([B| Bs], As) -> - eot(Bs, [B| As]); -eot([], _As) -> - more. - -%% -%% mk_cmd(Cmd) -> {ok, ShellCommandString} | {error, ErrorString} -%% -%% We do not allow any input to Cmd (hence commands that want -%% to read from standard input will return immediately). -%% Standard error is redirected to standard output. -%% -%% We use ^D (= EOT = 4) to mark the end of the stream. -%% -mk_cmd(Cmd) when is_atom(Cmd) -> % backward comp. - mk_cmd(atom_to_list(Cmd)); -mk_cmd(Cmd) -> - %% We insert a new line after the command, in case the command - %% contains a comment character. - [$(, unicode:characters_to_binary(Cmd), "\n) </dev/null; echo \"\^D\"\n"]. - +mk_cmd({win32,Wtype}, Cmd) -> + Command = case {os:getenv("COMSPEC"),Wtype} of + {false,windows} -> lists:concat(["command.com /c", Cmd]); + {false,_} -> lists:concat(["cmd /c", Cmd]); + {Cspec,_} -> lists:concat([Cspec," /c",Cmd]) + end, + {Command, [], []}; +mk_cmd(OsType,Cmd) when is_atom(Cmd) -> + mk_cmd(OsType, atom_to_list(Cmd)); +mk_cmd(_,Cmd) -> + %% Have to send command in like this in order to make sh commands like + %% cd and ulimit available + {"/bin/sh -s unix:cmd", [out], + %% We insert a new line after the command, in case the command + %% contains a comment character. + ["(", unicode:characters_to_binary(Cmd), "\n); exit\n"]}. validate(Atom) when is_atom(Atom) -> ok; @@ -397,7 +270,7 @@ validate1([]) -> get_data(Port, Sofar) -> receive {Port, {data, Bytes}} -> - get_data(Port, [Sofar|Bytes]); + get_data(Port, [Sofar,Bytes]); {Port, eof} -> Port ! {self(), close}, receive @@ -410,5 +283,5 @@ get_data(Port, Sofar) -> after 1 -> % force context switch ok end, - lists:flatten(Sofar) + iolist_to_binary(Sofar) end. diff --git a/lib/kernel/src/seq_trace.erl b/lib/kernel/src/seq_trace.erl index 07ccd3e494..a7a782c29c 100644 --- a/lib/kernel/src/seq_trace.erl +++ b/lib/kernel/src/seq_trace.erl @@ -23,7 +23,9 @@ -define(SEQ_TRACE_SEND, 1). %(1 << 0) -define(SEQ_TRACE_RECEIVE, 2). %(1 << 1) -define(SEQ_TRACE_PRINT, 4). %(1 << 2) --define(SEQ_TRACE_TIMESTAMP, 8). %(1 << 3) +-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, @@ -37,7 +39,7 @@ %%--------------------------------------------------------------------------- --type flag() :: 'send' | 'receive' | 'print' | 'timestamp'. +-type flag() :: 'send' | 'receive' | 'print' | 'timestamp' | 'monotonic_timestamp' | 'strict_monotonic_timestamp'. -type component() :: 'label' | 'serial' | flag(). -type value() :: (Integer :: non_neg_integer()) | {Previous :: non_neg_integer(), @@ -135,5 +137,9 @@ decode_flags(Flags) -> Print = (Flags band ?SEQ_TRACE_PRINT) > 0, Send = (Flags band ?SEQ_TRACE_SEND) > 0, Rec = (Flags band ?SEQ_TRACE_RECEIVE) > 0, - Ts = (Flags band ?SEQ_TRACE_TIMESTAMP) > 0, - [{print,Print},{send,Send},{'receive',Rec},{timestamp,Ts}]. + NowTs = (Flags band ?SEQ_TRACE_NOW_TIMESTAMP) > 0, + StrictMonTs = (Flags band ?SEQ_TRACE_STRICT_MON_TIMESTAMP) > 0, + MonTs = (Flags band ?SEQ_TRACE_MON_TIMESTAMP) > 0, + [{print,Print},{send,Send},{'receive',Rec},{timestamp,NowTs}, + {strict_monotonic_timestamp, StrictMonTs}, + {monotonic_timestamp, MonTs}]. diff --git a/lib/kernel/src/user_drv.erl b/lib/kernel/src/user_drv.erl index ca3c53ff93..b794d4f45e 100644 --- a/lib/kernel/src/user_drv.erl +++ b/lib/kernel/src/user_drv.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. 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. @@ -559,6 +559,7 @@ put_int16(N, Tail) -> %% is sent back to the process sending the request. This command was added in %% OTP 18 to make sure that data sent from io:format is actually printed %% to the console before the vm stops when calling erlang:halt(integer()). +-dialyzer({no_improper_lists, io_command/1}). io_command({put_chars_sync, unicode,Cs,Reply}) -> {{command,[?OP_PUTC_SYNC|unicode:characters_to_binary(Cs,utf8)]},Reply}; io_command({put_chars, unicode,Cs}) -> diff --git a/lib/kernel/test/Makefile b/lib/kernel/test/Makefile index 9e972b4f95..ba40dd3168 100644 --- a/lib/kernel/test/Makefile +++ b/lib/kernel/test/Makefile @@ -112,7 +112,7 @@ RELSYSDIR = $(RELEASE_PATH)/kernel_test # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +ERL_COMPILE_FLAGS += EBIN = . diff --git a/lib/kernel/test/application_SUITE.erl b/lib/kernel/test/application_SUITE.erl index 0c198b90ae..0ff512bb6e 100644 --- a/lib/kernel/test/application_SUITE.erl +++ b/lib/kernel/test/application_SUITE.erl @@ -19,7 +19,7 @@ %% -module(application_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2 diff --git a/lib/kernel/test/bif_SUITE.erl b/lib/kernel/test/bif_SUITE.erl index dd3010567a..284ca8f377 100644 --- a/lib/kernel/test/bif_SUITE.erl +++ b/lib/kernel/test/bif_SUITE.erl @@ -38,7 +38,7 @@ -export([init_per_testcase/2, end_per_testcase/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). % Default timetrap timeout (set in init_per_testcase). -define(default_timeout, ?t:minutes(1)). diff --git a/lib/kernel/test/cleanup.erl b/lib/kernel/test/cleanup.erl index 7eb0a9e140..7f623b9fc3 100644 --- a/lib/kernel/test/cleanup.erl +++ b/lib/kernel/test/cleanup.erl @@ -21,7 +21,7 @@ -export([all/0,groups/0,init_per_group/2,end_per_group/2, cleanup/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). all() -> [cleanup]. diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl index ef5303defd..cf8863fcd0 100644 --- a/lib/kernel/test/code_SUITE.erl +++ b/lib/kernel/test/code_SUITE.erl @@ -19,7 +19,7 @@ %% -module(code_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2]). -export([set_path/1, get_path/1, add_path/1, add_paths/1, del_path/1, @@ -30,8 +30,7 @@ upgrade/1, sticky_dir/1, pa_pz_option/1, add_del_path/1, dir_disappeared/1, ext_mod_dep/1, clash/1, - load_cached/1, start_node_with_cache/1, add_and_rehash/1, - where_is_file_cached/1, where_is_file_no_cache/1, + where_is_file/1, purge_stacktrace/1, mult_lib_roots/1, bad_erl_libs/1, code_archive/1, code_archive2/1, on_load/1, on_load_binary/1, on_load_embedded/1, on_load_errors/1, big_boot_embedded/1, @@ -56,9 +55,8 @@ all() -> load_binary, dir_req, object_code, set_path_file, upgrade, sticky_dir, pa_pz_option, add_del_path, dir_disappeared, - ext_mod_dep, clash, load_cached, start_node_with_cache, - add_and_rehash, where_is_file_no_cache, - where_is_file_cached, purge_stacktrace, mult_lib_roots, + ext_mod_dep, clash, where_is_file, + purge_stacktrace, mult_lib_roots, bad_erl_libs, code_archive, code_archive2, on_load, on_load_binary, on_load_embedded, on_load_errors, big_boot_embedded, native_early_modules, get_mode]. @@ -323,6 +321,7 @@ load_abs(Config) when is_list(Config) -> {error, nofile} = code:load_abs(TestDir ++ "/duuuumy_mod"), {error, badfile} = code:load_abs(TestDir ++ "/code_a_test"), {'EXIT', _} = (catch code:load_abs({})), + {'EXIT', _} = (catch code:load_abs("Non-latin-имя-файла")), {module, code_b_test} = code:load_abs(TestDir ++ "/code_b_test"), code:stick_dir(TestDir), {error, sticky_directory} = code:load_abs(TestDir ++ "/code_b_test"), @@ -382,8 +381,23 @@ purge(Config) when is_list(Config) -> purge_many_exits(Config) when is_list(Config) -> OldFlag = process_flag(trap_exit, true), + code:purge(code_b_test), {'EXIT',_} = (catch code:purge({})), + + CodePurgeF = fun(M, Exp) -> Exp = code:purge(M) end, + purge_many_exits_do(CodePurgeF), + + %% Let's repeat test for erlang:purge_module as it does the same thing + %% now in erts-8.0 (except for return value). + ErlangPurgeF = fun(M, _Exp) -> erlang:purge_module(M) end, + purge_many_exits_do(ErlangPurgeF), + + process_flag(trap_exit, OldFlag), + ok. + + +purge_many_exits_do(PurgeF) -> false = code:purge(code_b_test), TPids = lists:map(fun (_) -> {code_b_test:do_spawn(), @@ -402,7 +416,7 @@ purge_many_exits(Config) when is_list(Config) -> false = code_b_test:check_exit(Pid1), true = erlang:is_process_alive(Pid2) end, TPids), - true = code:purge(code_b_test), + PurgeF(code_b_test, true), lists:foreach(fun ({Pid1, Pid2}) -> false = erlang:is_process_alive(Pid1), true = code_b_test:check_exit(Pid1), @@ -411,9 +425,7 @@ purge_many_exits(Config) when is_list(Config) -> end, TPids), lists:foreach(fun ({_Pid1, Pid2}) -> receive {'EXIT', Pid2, _} -> ok end - end, TPids), - process_flag(trap_exit, OldFlag), - ok. + end, TPids). soft_purge(suite) -> []; @@ -669,13 +681,9 @@ add_del_path(Config) when is_list(Config) -> clash(Config) when is_list(Config) -> DDir = ?config(data_dir,Config)++"clash/", P = code:get_path(), - [TestServerPath|_] = [Path || Path <- code:get_path(), - re:run(Path,"test_server/?$",[unicode]) /= nomatch], %% test non-clashing entries - %% remove TestServerPath to prevent clash with test-server path - true = code:del_path(TestServerPath), true = code:add_path(DDir++"foobar-0.1/ebin"), true = code:add_path(DDir++"zork-0.8/ebin"), test_server:capture_start(), @@ -687,8 +695,6 @@ clash(Config) when is_list(Config) -> %% test clashing entries - %% remove TestServerPath to prevent clash with test-server path - true = code:del_path(TestServerPath), true = code:add_path(DDir++"foobar-0.1/ebin"), true = code:add_path(DDir++"foobar-0.1.ez/foobar-0.1/ebin"), test_server:capture_start(), @@ -701,9 +707,7 @@ clash(Config) when is_list(Config) -> %% test "Bad path can't read" - %% remove TestServerPath to prevent clash with test-server path Priv = ?config(priv_dir, Config), - true = code:del_path(TestServerPath), TmpEzFile = Priv++"foobar-0.tmp.ez", {ok, _} = file:copy(DDir++"foobar-0.1.ez", TmpEzFile), true = code:add_path(TmpEzFile++"/foobar-0.1/ebin"), @@ -768,6 +772,7 @@ analyse([], [This={M,F,A}|Path], Visited, ErrCnt0) -> OK = [erlang, os, prim_file, erl_prim_loader, init, ets, code_server, lists, lists_sort, unicode, binary, filename, gb_sets, gb_trees, hipe_unified_loader, hipe_bifs, + erts_code_purger, prim_zip, zlib], ErrCnt1 = case lists:member(M, OK) or erlang:is_builtin(M,F,A) of @@ -838,18 +843,7 @@ check_funs({'$M_EXPR','$F_EXPR',1}, {code_server,start_link,1}]) -> 0; check_funs({'$M_EXPR','$F_EXPR',1}, [{lists,filter,2}, - {code_server,try_archive_subdirs,3}, - {code_server,all_archive_subdirs,1}, - {code_server,archive_subdirs,1}, - {code_server,insert_name,3}, - {code_server,replace_name,2}, - {code_server,update,2}, - {code_server,maybe_update,2}, - {code_server,do_add,4}, - {code_server,add_path,4}, - {code_server,handle_call,3}, - {code_server,loop,1}, - {code_server,system_continue,3}]) -> 0; + {code_server,try_archive_subdirs,3}|_]) -> 0; check_funs({'$M_EXPR','$F_EXPR',_}, [{erlang,apply,2}, {erlang,spawn_link,1}, @@ -904,140 +898,7 @@ uniq([H|T],A) -> uniq(T,[H|A]). -load_cached(suite) -> - []; -load_cached(doc) -> - []; -load_cached(Config) when is_list(Config) -> - Priv = ?config(priv_dir, Config), - WD = filename:dirname(code:which(?MODULE)), - {ok,Node} = - ?t:start_node(code_cache_node, peer, [{args, - "-pa \"" ++ WD ++ "\""}, - {erl, [this]}]), - CCTabCreated = fun(Tab) -> - case ets:info(Tab, name) of - code_cache -> true; - _ -> false - end - end, - Tabs = rpc:call(Node, ets, all, []), - case rpc:call(Node, lists, any, [CCTabCreated,Tabs]) of - true -> - ?t:stop_node(Node), - ?t:fail("Code cache should not be active!"); - false -> - ok - end, - rpc:call(Node, code, del_path, [Priv]), - rpc:call(Node, code, add_pathz, [Priv]), - - FullModName = Priv ++ "/code_cache_test", - {ok,Dev} = file:open(FullModName ++ ".erl", [write]), - io:format(Dev, "-module(code_cache_test). -export([a/0]). a() -> ok.~n", []), - ok = file:close(Dev), - {ok,code_cache_test} = compile:file(FullModName, [{outdir,Priv}]), - - F = fun load_loop/2, - N = 1000, - {T0,T1} = rpc:call(Node, erlang, apply, [F, [N,code_cache_test]]), - TNoCache = now_diff(T1, T0), - rpc:call(Node, code, rehash, []), - {T2,T3} = rpc:call(Node, erlang, apply, [F, [N,code_cache_test]]), - TCache = now_diff(T3, T2), - AvgNoCache = TNoCache/N, - AvgCache = TCache/N, - io:format("Avg. load time (no_cache/cache): ~w/~w~n", [AvgNoCache,AvgCache]), - ?t:stop_node(Node), - if AvgNoCache =< AvgCache -> - ?t:fail("Cache not working properly."); - true -> - ok - end. - -load_loop(N, M) -> - load_loop(N, M, now()). -load_loop(0, _M, T0) -> - {T0,now()}; -load_loop(N, M, T0) -> - code:load_file(M), - code:delete(M), - code:purge(M), - load_loop(N-1, M, T0). - -now_diff({A2, B2, C2}, {A1, B1, C1}) -> - ((A2-A1)*1000000 + B2-B1)*1000000 + C2-C1. - -start_node_with_cache(suite) -> - []; -start_node_with_cache(doc) -> - []; -start_node_with_cache(Config) when is_list(Config) -> - {ok,Node} = - ?t:start_node(code_cache_node, peer, [{args, - "-code_path_cache"}, - {erl, [this]}]), - Tabs = rpc:call(Node, ets, all, []), - io:format("Tabs: ~w~n", [Tabs]), - CCTabCreated = fun(Tab) -> - case rpc:call(Node, ets, info, [Tab,name]) of - code_cache -> true; - _ -> false - end - end, - true = lists:any(CCTabCreated, Tabs), - ?t:stop_node(Node), - ok. - -add_and_rehash(suite) -> - []; -add_and_rehash(doc) -> - []; -add_and_rehash(Config) when is_list(Config) -> - Priv = ?config(priv_dir, Config), - WD = filename:dirname(code:which(?MODULE)), - {ok,Node} = - ?t:start_node(code_cache_node, peer, [{args, - "-pa \"" ++ WD ++ "\""}, - {erl, [this]}]), - CCTabCreated = fun(Tab) -> - case ets:info(Tab, name) of - code_cache -> true; - _ -> false - end - end, - Tabs0 = rpc:call(Node, ets, all, []), - case rpc:call(Node, lists, any, [CCTabCreated,Tabs0]) of - true -> - ?t:stop_node(Node), - ?t:fail("Code cache should not be active!"); - false -> - ok - end, - ok = rpc:call(Node, code, rehash, []), % create cache - Tabs1 = rpc:call(Node, ets, all, []), - true = rpc:call(Node, lists, any, [CCTabCreated,Tabs1]), % cache table created - ok = rpc:call(Node, code, rehash, []), - OkDir = filename:join(Priv, ""), - BadDir = filename:join(Priv, "guggemuffsussiputt"), - CP = [OkDir | rpc:call(Node, code, get_path, [])], - true = rpc:call(Node, code, set_path, [CP]), - CP1 = [BadDir | CP], - {error,_} = rpc:call(Node, code, set_path, [CP1]), - true = rpc:call(Node, code, del_path, [OkDir]), - true = rpc:call(Node, code, add_path, [OkDir]), - true = rpc:call(Node, code, add_path, [OkDir]), - {error,_} = rpc:call(Node, code, add_path, [BadDir]), - ok = rpc:call(Node, code, rehash, []), - - ?t:stop_node(Node), - ok. - -where_is_file_no_cache(suite) -> - []; -where_is_file_no_cache(doc) -> - []; -where_is_file_no_cache(Config) when is_list(Config) -> +where_is_file(Config) when is_list(Config) -> {T,KernelBeamFile} = timer:tc(code, where_is_file, ["kernel.beam"]), io:format("Load time: ~w ms~n", [T]), KernelEbinDir = filename:dirname(KernelBeamFile), @@ -1046,35 +907,6 @@ where_is_file_no_cache(Config) when is_list(Config) -> non_existing = code:where_is_file("kernel"), % no such file ok. -where_is_file_cached(suite) -> - []; -where_is_file_cached(doc) -> - []; -where_is_file_cached(Config) when is_list(Config) -> - {ok,Node} = - ?t:start_node(code_cache_node, peer, [{args, - "-code_path_cache"}, - {erl, [this]}]), - Tabs = rpc:call(Node, ets, all, []), - io:format("Tabs: ~w~n", [Tabs]), - CCTabCreated = fun(Tab) -> - case rpc:call(Node, ets, info, [Tab,name]) of - code_cache -> true; - _ -> false - end - end, - true = lists:any(CCTabCreated, Tabs), - KernelBeamFile = rpc:call(Node, code, where_is_file, ["kernel.beam"]), - {T,KernelBeamFile} = rpc:call(Node, timer, tc, [code,where_is_file,["kernel.beam"]]), - io:format("Load time: ~w ms~n", [T]), - KernelEbinDir = rpc:call(Node, filename, dirname, [KernelBeamFile]), - AppFile = rpc:call(Node, filename, join, [KernelEbinDir,"kernel.app"]), - AppFile = rpc:call(Node, code, where_is_file, ["kernel.app"]), - non_existing = rpc:call(Node, code, where_is_file, ["kernel"]), % no such file - ?t:stop_node(Node), - ok. - - purge_stacktrace(suite) -> []; purge_stacktrace(doc) -> @@ -1599,6 +1431,17 @@ on_load_errors(Config) when is_list(Config) -> ok end, + %% Make sure that the code loading functions return the correct + %% error code. + Simple = simple_on_load_error, + SimpleList = atom_to_list(Simple), + {error,on_load_failure} = code:load_file(Simple), + {error,on_load_failure} = code:ensure_loaded(Simple), + {ok,SimpleCode} = file:read_file("simple_on_load_error.beam"), + {error,on_load_failure} = code:load_binary(Simple, "", SimpleCode), + {error,on_load_failure} = code:load_abs(SimpleList), + {error,on_load_failure} = code:load_abs(SimpleList, Simple), + ok. do_on_load_error(ReturnValue) -> diff --git a/lib/kernel/test/code_SUITE_data/on_load_errors/simple_on_load_error.erl b/lib/kernel/test/code_SUITE_data/on_load_errors/simple_on_load_error.erl new file mode 100644 index 0000000000..603c282257 --- /dev/null +++ b/lib/kernel/test/code_SUITE_data/on_load_errors/simple_on_load_error.erl @@ -0,0 +1,5 @@ +-module(simple_on_load_error). +-on_load(on_load/0). + +on_load() -> + nope. diff --git a/lib/kernel/test/disk_log_SUITE.erl b/lib/kernel/test/disk_log_SUITE.erl index 9988347581..21da958c11 100644 --- a/lib/kernel/test/disk_log_SUITE.erl +++ b/lib/kernel/test/disk_log_SUITE.erl @@ -29,7 +29,7 @@ -define(config(X,Y), foo). -define(t,test_server). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(format(S, A), ok). -define(privdir(Conf), ?config(priv_dir, Conf)). -define(datadir(Conf), ?config(data_dir, Conf)). diff --git a/lib/kernel/test/erl_boot_server_SUITE.erl b/lib/kernel/test/erl_boot_server_SUITE.erl index 954880e252..2450761ac9 100644 --- a/lib/kernel/test/erl_boot_server_SUITE.erl +++ b/lib/kernel/test/erl_boot_server_SUITE.erl @@ -19,7 +19,7 @@ %% -module(erl_boot_server_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). diff --git a/lib/kernel/test/erl_distribution_SUITE.erl b/lib/kernel/test/erl_distribution_SUITE.erl index 2f73ab170a..3ac87384b4 100644 --- a/lib/kernel/test/erl_distribution_SUITE.erl +++ b/lib/kernel/test/erl_distribution_SUITE.erl @@ -20,7 +20,7 @@ -module(erl_distribution_SUITE). %-define(line_trace, 1). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). diff --git a/lib/kernel/test/erl_distribution_wb_SUITE.erl b/lib/kernel/test/erl_distribution_wb_SUITE.erl index c107e92fae..e453cb2cdd 100644 --- a/lib/kernel/test/erl_distribution_wb_SUITE.erl +++ b/lib/kernel/test/erl_distribution_wb_SUITE.erl @@ -19,7 +19,7 @@ %% -module(erl_distribution_wb_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/inet.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/lib/kernel/test/erl_prim_loader_SUITE.erl b/lib/kernel/test/erl_prim_loader_SUITE.erl index 0803cf428f..bc14a2764d 100644 --- a/lib/kernel/test/erl_prim_loader_SUITE.erl +++ b/lib/kernel/test/erl_prim_loader_SUITE.erl @@ -20,7 +20,7 @@ -module(erl_prim_loader_SUITE). -include_lib("kernel/include/file.hrl"). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). @@ -133,14 +133,8 @@ inet_existing(doc) -> ["Start a node using the 'inet' loading method, ", "from an already started boot server."]; inet_existing(Config) when is_list(Config) -> Name = erl_prim_test_inet_existing, - Host = host(), - Cookie = atom_to_list(erlang:get_cookie()), - IpStr = ip_str(Host), - LFlag = get_loader_flag(os:type()), - Args = LFlag ++ " -hosts " ++ IpStr ++ - " -setcookie " ++ Cookie, - {ok, BootPid} = erl_boot_server:start_link([Host]), - {ok, Node} = start_node(Name, Args), + BootPid = start_boot_server(), + Node = start_node_using_inet(Name), {ok,[["inet"]]} = rpc:call(Node, init, get_argument, [loader]), stop_node(Node), unlink(BootPid), @@ -151,19 +145,11 @@ inet_coming_up(doc) -> ["Start a node using the 'inet' loading method, ", "but start the boot server afterwards."]; inet_coming_up(Config) when is_list(Config) -> Name = erl_prim_test_inet_coming_up, - Cookie = atom_to_list(erlang:get_cookie()), - Host = host(), - IpStr = ip_str(Host), - LFlag = get_loader_flag(os:type()), - Args = LFlag ++ - " -hosts " ++ IpStr ++ - " -setcookie " ++ Cookie, - {ok, Node} = start_node(Name, Args, [{wait, false}]), + Node = start_node_using_inet(Name, [{wait,false}]), %% Wait a while, then start boot server, and wait for node to start. test_server:sleep(test_server:seconds(6)), - io:format("erl_boot_server:start_link([~p]).", [Host]), - {ok, BootPid} = erl_boot_server:start_link([Host]), + BootPid = start_boot_server(), wait_really_started(Node, 25), %% Check loader argument, then cleanup. @@ -191,24 +177,19 @@ inet_disconnects(Config) when is_list(Config) -> true -> {skip,"erl_boot_server is native"}; false -> - ?line Name = erl_prim_test_inet_disconnects, - ?line Host = host(), - ?line Cookie = atom_to_list(erlang:get_cookie()), - ?line IpStr = ip_str(Host), - ?line LFlag = get_loader_flag(os:type()), - ?line Args = LFlag ++ " -hosts " ++ IpStr ++ - " -setcookie " ++ Cookie, + Name = erl_prim_test_inet_disconnects, - ?line {ok, BootPid} = erl_boot_server:start([Host]), + BootPid = start_boot_server(), + unlink(BootPid), Self = self(), %% This process shuts down the boot server during loading. - ?line Stopper = spawn_link(fun() -> stop_boot(BootPid, Self) end), - ?line receive - {Stopper,ready} -> ok - end, + Stopper = spawn_link(fun() -> stop_boot(BootPid, Self) end), + receive + {Stopper,ready} -> ok + end, %% Let the loading begin... - ?line {ok, Node} = start_node(Name, Args, [{wait, false}]), + Node = start_node_using_inet(Name, [{wait,false}]), %% When the stopper is ready, the slave node should be %% looking for a boot server again. @@ -222,12 +203,12 @@ inet_disconnects(Config) when is_list(Config) -> end, %% Start new boot server to see that loading is continued. - ?line {ok, BootPid2} = erl_boot_server:start_link([Host]), - ?line wait_really_started(Node, 25), - ?line {ok,[["inet"]]} = rpc:call(Node, init, get_argument, [loader]), - ?line stop_node(Node), - ?line unlink(BootPid2), - ?line exit(BootPid2, kill), + BootPid2 = start_boot_server(), + wait_really_started(Node, 25), + {ok,[["inet"]]} = rpc:call(Node, init, get_argument, [loader]), + stop_node(Node), + unlink(BootPid2), + exit(BootPid2, kill), ok end. @@ -260,46 +241,38 @@ multiple_slaves(doc) -> ["Start nodes in parallell, all using the 'inet' loading method, ", "verify that the boot server manages"]; multiple_slaves(Config) when is_list(Config) -> - case os:type() of - {ose,_} -> - {comment, "OSE: multiple nodes not supported"}; - _ -> - ?line Name = erl_prim_test_multiple_slaves, - ?line Host = host(), - ?line Cookie = atom_to_list(erlang:get_cookie()), - ?line IpStr = ip_str(Host), - ?line LFlag = get_loader_flag(os:type()), - ?line Args = LFlag ++ " -hosts " ++ IpStr ++ - " -setcookie " ++ Cookie, - - NoOfNodes = 10, % no of slave nodes to be started - - NamesAndNodes = - lists:map(fun(N) -> - NameN = atom_to_list(Name) ++ - integer_to_list(N), - NodeN = NameN ++ "@" ++ Host, - {list_to_atom(NameN),list_to_atom(NodeN)} - end, lists:seq(1, NoOfNodes)), - - ?line Nodes = start_multiple_nodes(NamesAndNodes, Args, []), - - %% "queue up" the nodes to wait for the boot server to respond - %% (note: test_server supervises each node start by accept() - %% on a socket, the timeout value for the accept has to be quite - %% long for this test to work). - ?line test_server:sleep(test_server:seconds(5)), - %% start the code loading circus! - ?line {ok,BootPid} = erl_boot_server:start_link([Host]), - %% give the nodes a chance to boot up before attempting to stop them - ?line test_server:sleep(test_server:seconds(10)), - - ?line wait_and_shutdown(lists:reverse(Nodes), 30), - - ?line unlink(BootPid), - ?line exit(BootPid, kill), - ok - end. + ?line Name = erl_prim_test_multiple_slaves, + ?line Host = host(), + ?line IpStr = ip_str(Host), + Args = " -loader inet -hosts " ++ IpStr, + + NoOfNodes = 10, % no of slave nodes to be started + + NamesAndNodes = + lists:map(fun(N) -> + NameN = atom_to_list(Name) ++ + integer_to_list(N), + NodeN = NameN ++ "@" ++ Host, + {list_to_atom(NameN),list_to_atom(NodeN)} + end, lists:seq(1, NoOfNodes)), + + ?line Nodes = start_multiple_nodes(NamesAndNodes, Args, []), + + %% "queue up" the nodes to wait for the boot server to respond + %% (note: test_server supervises each node start by accept() + %% on a socket, the timeout value for the accept has to be quite + %% long for this test to work). + ?line test_server:sleep(test_server:seconds(5)), + %% start the code loading circus! + BootPid = start_boot_server(), + %% give the nodes a chance to boot up before attempting to stop them + ?line test_server:sleep(test_server:seconds(10)), + + ?line wait_and_shutdown(lists:reverse(Nodes), 30), + + ?line unlink(BootPid), + ?line exit(BootPid, kill), + ok. start_multiple_nodes([{Name,Node} | NNs], Args, Started) -> ?line {ok,Node} = start_node(Name, Args, [{wait, false}]), @@ -367,20 +340,6 @@ file_requests(Config) when is_list(Config) -> ?line exit(BootPid, kill), ok. -complete_start_node(Name) -> - ?line Host = host(), - ?line Cookie = atom_to_list(erlang:get_cookie()), - ?line IpStr = ip_str(Host), - ?line LFlag = get_loader_flag(os:type()), - ?line Args = LFlag ++ " -hosts " ++ IpStr ++ - " -setcookie " ++ Cookie, - - ?line {ok,BootPid} = erl_boot_server:start_link([Host]), - - ?line {ok,Node} = start_node(Name, Args), - ?line wait_really_started(Node, 25), - {ok, Node, BootPid}. - local_archive(suite) -> []; local_archive(doc) -> @@ -397,7 +356,7 @@ local_archive(Config) when is_list(Config) -> ?line ok = test_archive(Node, Archive, KernelDir, BeamName), %% Cleanup - ?line ok = rpc:call(Node, erl_prim_loader, release_archives, []), + ok = rpc:call(Node, erl_prim_loader, purge_archive_cache, []), ?line ok = file:delete(Archive), ok. @@ -555,11 +514,41 @@ virtual_dir_in_archive(Config) when is_list(Config) -> ?line {ok, [EbinBase]} = erl_prim_loader:list_dir(AppDir), %% Cleanup - ?line ok = erl_prim_loader:release_archives(), + ok = erl_prim_loader:purge_archive_cache(), ?line ok = file:delete(Archive), ok. -%% Misc. functions +%%% +%%% Helper functions. +%%% + +complete_start_node(Name) -> + BootPid = start_boot_server(), + Node = start_node_using_inet(Name), + wait_really_started(Node, 25), + {ok, Node, BootPid}. + +start_boot_server() -> + %% Many linux systems define: + %% 127.0.0.1 localhost + %% 127.0.1.1 somehostname + %% Therefore, to allow the tests to work on those kind of systems, + %% also include "localhost" in the list of allowed hosts. + + Hosts = [host(),ip_str("localhost")], + {ok,BootPid} = erl_boot_server:start_link(Hosts), + BootPid. + +start_node_using_inet(Name) -> + start_node_using_inet(Name, []). + +start_node_using_inet(Name, Opts) -> + Host = host(), + IpStr = ip_str(Host), + Args = " -loader inet -hosts " ++ IpStr, + {ok,Node} = start_node(Name, Args, Opts), + Node. + ip_str({A, B, C, D}) -> lists:concat([A, ".", B, ".", C, ".", D]); @@ -585,9 +574,6 @@ host() -> stop_node(Node) -> test_server:stop_node(Node). -get_loader_flag(_) -> - " -loader inet ". - compile_app(TopDir, AppName) -> AppDir = filename:join([TopDir, AppName]), SrcDir = filename:join([AppDir, "src"]), diff --git a/lib/kernel/test/error_logger_SUITE.erl b/lib/kernel/test/error_logger_SUITE.erl index f1988b68d9..fa0fc5b75c 100644 --- a/lib/kernel/test/error_logger_SUITE.erl +++ b/lib/kernel/test/error_logger_SUITE.erl @@ -19,7 +19,7 @@ %% -module(error_logger_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %%----------------------------------------------------------------- %% We don't have to test the normal behaviour here, i.e. the tty diff --git a/lib/kernel/test/error_logger_warn_SUITE.erl b/lib/kernel/test/error_logger_warn_SUITE.erl index a3a3b2f8c6..40b3f6bd53 100644 --- a/lib/kernel/test/error_logger_warn_SUITE.erl +++ b/lib/kernel/test/error_logger_warn_SUITE.erl @@ -29,7 +29,7 @@ %% Internal exports. -export([init/1,handle_event/2,handle_info/2,handle_call/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(EXPECT(Pattern), (fun() -> diff --git a/lib/kernel/test/file_SUITE.erl b/lib/kernel/test/file_SUITE.erl index 09d9a45197..e9401e26ef 100644 --- a/lib/kernel/test/file_SUITE.erl +++ b/lib/kernel/test/file_SUITE.erl @@ -106,7 +106,7 @@ %% System probe functions that might be handy to check from the shell -export([disc_free/1, memsize/0]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). -define(THROW_ERROR(RES), throw({fail, ?LINE, RES})). @@ -168,12 +168,7 @@ init_per_suite(Config) when is_list(Config) -> ok -> [{sasl,started}] end, - ok = case os:type() of - {ose,_} -> - ok; - _ -> - application:start(os_mon) - end, + application:start(os_mon), case os:type() of {win32, _} -> @@ -199,12 +194,7 @@ end_per_suite(Config) when is_list(Config) -> ok end, - case os:type() of - {ose,_} -> - ok; - _ -> - application:stop(os_mon) - end, + application:stop(os_mon), case proplists:get_value(sasl, Config) of started -> application:stop(sasl); @@ -889,10 +879,7 @@ open1(Config) when is_list(Config) -> ?line io:format(Fd1,Str,[]), ?line {ok,0} = ?FILE_MODULE:position(Fd1,bof), ?line Str = io:get_line(Fd1,''), - ?line case io:get_line(Fd2,'') of - Str -> Str; - eof -> Str - end, + ?line Str = io:get_line(Fd2,''), ?line ok = ?FILE_MODULE:close(Fd2), ?line {ok,0} = ?FILE_MODULE:position(Fd1,bof), ?line ok = ?FILE_MODULE:truncate(Fd1), @@ -2368,9 +2355,6 @@ e_rename(Config) when is_list(Config) -> %% At least Windows NT can %% successfully move a file to %% another drive. - ok; - {ose, _} -> - %% disabled for now ok end, [] = flush(), diff --git a/lib/kernel/test/file_name_SUITE.erl b/lib/kernel/test/file_name_SUITE.erl index 32006d893e..e6f8761f95 100644 --- a/lib/kernel/test/file_name_SUITE.erl +++ b/lib/kernel/test/file_name_SUITE.erl @@ -19,7 +19,7 @@ %% %CopyrightEnd% %% --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). %% @@ -159,7 +159,7 @@ normalize(suite) -> normalize(doc) -> ["Check that filename normalization works"]; normalize(Config) when is_list(Config) -> - random:seed({1290,431421,830412}), + rand:seed(exsplus, {1290,431421,830412}), try ?line UniMode = file:native_name_encoding() =/= latin1, if @@ -845,7 +845,7 @@ conv(L) -> rand_comp_decomp(Max) -> - N = random:uniform(Max), + N = rand:uniform(Max), L = [ rand_decomp() || _ <- lists:seq(1,N) ], LC = [ A || {A,_} <- L], LD = lists:flatten([B || {_,B} <- L]), @@ -855,7 +855,7 @@ rand_comp_decomp(Max) -> rand_decomp() -> BT = bigtup(), SZ = tuple_size(BT), - element(random:uniform(SZ),BT). + element(rand:uniform(SZ),BT). bigtup() -> {{192,[65,768]}, {200,[69,768]}, diff --git a/lib/kernel/test/gen_sctp_SUITE.erl b/lib/kernel/test/gen_sctp_SUITE.erl index 91a57d3290..99f8625ba9 100644 --- a/lib/kernel/test/gen_sctp_SUITE.erl +++ b/lib/kernel/test/gen_sctp_SUITE.erl @@ -19,7 +19,7 @@ %% -module(gen_sctp_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/inet_sctp.hrl"). %%-compile(export_all). diff --git a/lib/kernel/test/gen_tcp_echo_SUITE.erl b/lib/kernel/test/gen_tcp_echo_SUITE.erl index 6dcb21758b..fe81cbac18 100644 --- a/lib/kernel/test/gen_tcp_echo_SUITE.erl +++ b/lib/kernel/test/gen_tcp_echo_SUITE.erl @@ -19,7 +19,7 @@ %% -module(gen_tcp_echo_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %%-compile(export_all). @@ -442,14 +442,7 @@ random_char(Chars) -> lists:nth(uniform(length(Chars)), Chars). uniform(N) -> - case get(random_seed) of - undefined -> - {X, Y, Z} = time(), - random:seed(X, Y, Z); - _ -> - ok - end, - random:uniform(N). + rand:uniform(N). put_int32(X, big, List) -> [ (X bsr 24) band 16#ff, diff --git a/lib/kernel/test/gen_tcp_misc_SUITE.erl b/lib/kernel/test/gen_tcp_misc_SUITE.erl index 81c6dcd0fd..323796665b 100644 --- a/lib/kernel/test/gen_tcp_misc_SUITE.erl +++ b/lib/kernel/test/gen_tcp_misc_SUITE.erl @@ -19,7 +19,7 @@ %% -module(gen_tcp_misc_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %-compile(export_all). @@ -58,14 +58,6 @@ oct_acceptor/1, otp_7731_server/1, zombie_server/2, do_iter_max_socks/2]). -init_per_testcase(wrapping_oct, Config) when is_list(Config) -> - Dog = case os:type() of - {ose,_} -> - test_server:timetrap(test_server:minutes(20)); - _Else -> - test_server:timetrap(test_server:seconds(600)) - end, - [{watchdog, Dog}|Config]; init_per_testcase(iter_max_socks, Config) when is_list(Config) -> Dog = case os:type() of {win32,_} -> @@ -74,14 +66,6 @@ init_per_testcase(iter_max_socks, Config) when is_list(Config) -> test_server:timetrap(test_server:seconds(240)) end, [{watchdog, Dog}|Config]; -init_per_testcase(accept_system_limit, Config) when is_list(Config) -> - case os:type() of - {ose,_} -> - {skip,"Skip in OSE"}; - _ -> - Dog = test_server:timetrap(test_server:seconds(240)), - [{watchdog,Dog}|Config] - end; init_per_testcase(wrapping_oct, Config) when is_list(Config) -> Dog = test_server:timetrap(test_server:seconds(600)), [{watchdog, Dog}|Config]; diff --git a/lib/kernel/test/gen_udp_SUITE.erl b/lib/kernel/test/gen_udp_SUITE.erl index 8d8c953303..2efbf26e1c 100644 --- a/lib/kernel/test/gen_udp_SUITE.erl +++ b/lib/kernel/test/gen_udp_SUITE.erl @@ -22,7 +22,7 @@ % because udp is not deterministic. % -module(gen_udp_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(default_timeout, ?t:minutes(1)). diff --git a/lib/kernel/test/global_SUITE.erl b/lib/kernel/test/global_SUITE.erl index 73ee86eba4..0046fdafa4 100644 --- a/lib/kernel/test/global_SUITE.erl +++ b/lib/kernel/test/global_SUITE.erl @@ -51,7 +51,7 @@ -compile(export_all). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(NODES, [node()|nodes()]). @@ -1349,7 +1349,7 @@ stress_partition(Config) when is_list(Config) -> %% Use this one to test alot of connection tests -%% erl -sname ts -rsh ctrsh -pa /clearcase/otp/internal_tools/test_server/ebin/ -ring_line 10000 -s test_server run_test global_SUITE +%% erl -sname ts -ring_line 10000 -s test_server run_test global_SUITE ring_line(suite) -> []; ring_line(doc) -> [""]; @@ -2931,7 +2931,7 @@ sync_until(LogFile) -> timer:sleep(Time). shuffle(L) -> - [E || {_, E} <- lists:keysort(1, [{random:uniform(), E} || E <- L])]. + [E || {_, E} <- lists:keysort(1, [{rand:uniform(), E} || E <- L])]. sync_0(suite) -> []; sync_0(doc) -> diff --git a/lib/kernel/test/global_group_SUITE.erl b/lib/kernel/test/global_group_SUITE.erl index 0a994c3bf0..e7d321418c 100644 --- a/lib/kernel/test/global_group_SUITE.erl +++ b/lib/kernel/test/global_group_SUITE.erl @@ -30,7 +30,7 @@ %-compile(export_all). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(NODES, [node()|nodes()]). diff --git a/lib/kernel/test/heart_SUITE.erl b/lib/kernel/test/heart_SUITE.erl index 83efbb4c35..4447475833 100644 --- a/lib/kernel/test/heart_SUITE.erl +++ b/lib/kernel/test/heart_SUITE.erl @@ -19,7 +19,7 @@ %% -module(heart_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, start/1, restart/1, diff --git a/lib/kernel/test/ignore_cores.erl b/lib/kernel/test/ignore_cores.erl index db61c4003b..6a37b48189 100644 --- a/lib/kernel/test/ignore_cores.erl +++ b/lib/kernel/test/ignore_cores.erl @@ -28,7 +28,7 @@ -module(ignore_cores). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([init/1, fini/1, setup/3, setup/4, restore/1, dir/1]). diff --git a/lib/kernel/test/inet_SUITE.erl b/lib/kernel/test/inet_SUITE.erl index 5ba06bb032..0a36bc9673 100644 --- a/lib/kernel/test/inet_SUITE.erl +++ b/lib/kernel/test/inet_SUITE.erl @@ -19,7 +19,7 @@ %% -module(inet_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/inet.hrl"). -include_lib("kernel/src/inet_dns.hrl"). @@ -868,7 +868,6 @@ gethostnative_control_2(Seq, Interval, Delay, Cnt, N, Hosts) -> ?line Lookupers = [spawn_link( fun () -> - random:seed(), lookup_loop(Hosts, Delay, Tag, Parent, Cnt, Hosts) end) || _ <- lists:seq(1, N)], @@ -929,7 +928,7 @@ lookup_loop([H|Hs], Delay, Tag, Parent, Cnt, Hosts) -> Parent ! {Tag,Error} end, receive - after random:uniform(Delay) -> + after rand:uniform(Delay) -> lookup_loop(Hs, Delay, Tag, Parent, Cnt-1, Hosts) end. diff --git a/lib/kernel/test/inet_res_SUITE.erl b/lib/kernel/test/inet_res_SUITE.erl index ace4ccb8bd..ea06061c74 100644 --- a/lib/kernel/test/inet_res_SUITE.erl +++ b/lib/kernel/test/inet_res_SUITE.erl @@ -20,7 +20,6 @@ -module(inet_res_SUITE). -include_lib("common_test/include/ct.hrl"). --include("test_server_line.hrl"). -include_lib("kernel/include/inet.hrl"). -include_lib("kernel/src/inet_dns.hrl"). @@ -120,7 +119,7 @@ ns_init(ZoneDir, PrivDir, DataDir) -> {unix,_} -> PortNum = case {os:type(),os:version()} of {{unix,solaris},{M,V,_}} when M =< 5, V < 10 -> - 11895 + random:uniform(100); + 11895 + rand:uniform(100); _ -> {ok,S} = gen_udp:open(0, [{reuseaddr,true}]), {ok,PNum} = inet:port(S), diff --git a/lib/kernel/test/inet_sockopt_SUITE.erl b/lib/kernel/test/inet_sockopt_SUITE.erl index cb522c8abe..a6981854c8 100644 --- a/lib/kernel/test/inet_sockopt_SUITE.erl +++ b/lib/kernel/test/inet_sockopt_SUITE.erl @@ -19,7 +19,7 @@ %% -module(inet_sockopt_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(C_GET_IPPROTO_TCP,1). diff --git a/lib/kernel/test/init_SUITE.erl b/lib/kernel/test/init_SUITE.erl index 54ab5aa566..cb531f7b57 100644 --- a/lib/kernel/test/init_SUITE.erl +++ b/lib/kernel/test/init_SUITE.erl @@ -19,7 +19,7 @@ %% -module(init_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). @@ -307,8 +307,8 @@ create_boot(Config) -> is_real_system(KernelVsn, StdlibVsn) -> LibDir = code:lib_dir(), - filelib:is_dir(filename:join(LibDir, "kernel"++KernelVsn)) andalso - filelib:is_dir(filename:join(LibDir, "stdlib"++StdlibVsn)). + filelib:is_dir(filename:join(LibDir, "kernel-"++KernelVsn)) andalso + filelib:is_dir(filename:join(LibDir, "stdlib-"++StdlibVsn)). %% ------------------------------------------------ %% Slave executes erlang:halt() on master nodedown. @@ -401,6 +401,7 @@ restart(Config) when is_list(Config) -> %% Ok, the node is up, now the real test test begins. ?line erlang:monitor_node(Node, true), ?line InitPid = rpc:call(Node, erlang, whereis, [init]), + ?line PurgerPid = rpc:call(Node, erlang, whereis, [erts_code_purger]), ?line Procs = rpc:call(Node, erlang, processes, []), ?line MaxPid = lists:last(Procs), ?line ok = rpc:call(Node, init, restart, []), @@ -418,8 +419,13 @@ restart(Config) when is_list(Config) -> InitP = pid_to_list(InitPid), ?line InitP = pid_to_list(InitPid1), + %% and same purger process! + ?line PurgerPid1 = rpc:call(Node, erlang, whereis, [erts_code_purger]), + PurgerP = pid_to_list(PurgerPid), + ?line PurgerP = pid_to_list(PurgerPid1), + ?line NewProcs0 = rpc:call(Node, erlang, processes, []), - NewProcs = lists:delete(InitPid1, NewProcs0), + NewProcs = NewProcs0 -- [InitPid1, PurgerPid1], ?line case check_processes(NewProcs, MaxPid) of true -> ok; diff --git a/lib/kernel/test/interactive_shell_SUITE.erl b/lib/kernel/test/interactive_shell_SUITE.erl index 8adae1f606..d7fa52b721 100644 --- a/lib/kernel/test/interactive_shell_SUITE.erl +++ b/lib/kernel/test/interactive_shell_SUITE.erl @@ -18,7 +18,7 @@ %% %CopyrightEnd% %% -module(interactive_shell_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -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, diff --git a/lib/kernel/test/kernel_SUITE.erl b/lib/kernel/test/kernel_SUITE.erl index 8ae2e4b23b..64c7ce6136 100644 --- a/lib/kernel/test/kernel_SUITE.erl +++ b/lib/kernel/test/kernel_SUITE.erl @@ -21,7 +21,7 @@ %%% Kernel application test suite. %%%----------------------------------------------------------------- -module(kernel_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). % Test server specific exports diff --git a/lib/kernel/test/kernel_config_SUITE.erl b/lib/kernel/test/kernel_config_SUITE.erl index 4be44015c9..1486619b1c 100644 --- a/lib/kernel/test/kernel_config_SUITE.erl +++ b/lib/kernel/test/kernel_config_SUITE.erl @@ -19,7 +19,7 @@ %% -module(kernel_config_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, sync/1]). diff --git a/lib/kernel/test/os_SUITE.erl b/lib/kernel/test/os_SUITE.erl index 29d8d10262..29fc3a2ea5 100644 --- a/lib/kernel/test/os_SUITE.erl +++ b/lib/kernel/test/os_SUITE.erl @@ -20,17 +20,20 @@ -module(os_SUITE). -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_group/2,end_per_group/2, + init_per_testcase/2,end_per_testcase/2]). -export([space_in_cwd/1, quoting/1, cmd_unicode/1, space_in_name/1, bad_command/1, - find_executable/1, unix_comment_in_command/1, deep_list_command/1, evil/1]). + find_executable/1, unix_comment_in_command/1, deep_list_command/1, + large_output_command/1, perf_counter_api/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [space_in_cwd, quoting, cmd_unicode, space_in_name, bad_command, - find_executable, unix_comment_in_command, deep_list_command, evil]. + find_executable, unix_comment_in_command, deep_list_command, + large_output_command, perf_counter_api]. groups() -> []. @@ -47,6 +50,11 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. +init_per_testcase(_TC,Config) -> + Config. + +end_per_testcase(_,_Config) -> + ok. space_in_cwd(doc) -> "Test that executing a command in a current working directory " @@ -267,50 +275,48 @@ deep_list_command(Config) when is_list(Config) -> %% FYI: [$e, $c, "ho"] =:= io_lib:format("ec~s", ["ho"]) ok. - --define(EVIL_PROCS, 100). --define(EVIL_LOOPS, 100). --define(PORT_CREATOR, os_cmd_port_creator). -evil(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:minutes(5)), - Parent = self(), - Ps = lists:map(fun (N) -> - spawn_link(fun () -> - evil_loop(Parent, ?EVIL_LOOPS,N) - end) - end, lists:seq(1, ?EVIL_PROCS)), - Devil = spawn_link(fun () -> devil(hd(Ps), hd(lists:reverse(Ps))) end), - lists:foreach(fun (P) -> receive {P, done} -> ok end end, Ps), - unlink(Devil), - exit(Devil, kill), - test_server:timetrap_cancel(Dog), - ok. - -devil(P1, P2) -> - erlang:display({?PORT_CREATOR, whereis(?PORT_CREATOR)}), - (catch ?PORT_CREATOR ! lists:seq(1,1000000)), - (catch ?PORT_CREATOR ! lists:seq(1,666)), - (catch ?PORT_CREATOR ! grrrrrrrrrrrrrrrr), - (catch ?PORT_CREATOR ! {'EXIT', P1, buhuuu}), - (catch ?PORT_CREATOR ! {'EXIT', hd(erlang:ports()), buhuuu}), - (catch ?PORT_CREATOR ! {'EXIT', P2, arggggggg}), - receive after 500 -> ok end, - (catch exit(whereis(?PORT_CREATOR), kill)), - (catch ?PORT_CREATOR ! ">8|"), - receive after 500 -> ok end, - (catch exit(whereis(?PORT_CREATOR), diiiiiiiiiiiiiiiiiiiie)), - receive after 100 -> ok end, - devil(P1, P2). - -evil_loop(Parent, Loops, N) -> - Res = integer_to_list(N), - evil_loop(Parent, Loops, Res, "echo " ++ Res). - -evil_loop(Parent, 0, _Res, _Cmd) -> - Parent ! {self(), done}; -evil_loop(Parent, Loops, Res, Cmd) -> - comp(Res, os:cmd(Cmd)), - evil_loop(Parent, Loops-1, Res, Cmd). +large_output_command(doc) -> + "Test to take sure that the correct data is" + "received when doing large commands"; +large_output_command(suite) -> []; +large_output_command(Config) when is_list(Config) -> + %% Maximum allowed on windows is 8192, so we test well below that + AAA = lists:duplicate(7000, $a), + comp(AAA,os:cmd("echo " ++ AAA)). + +%% Test that the os:perf_counter api works as expected +perf_counter_api(_Config) -> + + true = is_integer(os:perf_counter()), + true = os:perf_counter() > 0, + + T1 = os:perf_counter(), + timer:sleep(100), + T2 = os:perf_counter(), + TsDiff = erlang:convert_time_unit(T2 - T1, perf_counter, nano_seconds), + ct:pal("T1: ~p~n" + "T2: ~p~n" + "TsDiff: ~p~n", + [T1,T2,TsDiff]), + + %% We allow a 15% diff + true = TsDiff < 115000000, + true = TsDiff > 85000000, + + T1Ms = os:perf_counter(1000), + timer:sleep(100), + T2Ms = os:perf_counter(1000), + MsDiff = T2Ms - T1Ms, + ct:pal("T1Ms: ~p~n" + "T2Ms: ~p~n" + "MsDiff: ~p~n", + [T1Ms,T2Ms,MsDiff]), + + %% We allow a 15% diff + true = MsDiff < 115, + true = MsDiff > 85. + +%% Util functions comp(Expected, Got) -> case strip_nl(Got) of diff --git a/lib/kernel/test/pdict_SUITE.erl b/lib/kernel/test/pdict_SUITE.erl index 6de4ff9f77..80025d2fd9 100644 --- a/lib/kernel/test/pdict_SUITE.erl +++ b/lib/kernel/test/pdict_SUITE.erl @@ -21,7 +21,7 @@ %% NB: The ?line macro cannot be used when testing the dictionary. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(M(A,B),m(A,B,?MODULE,?LINE)). -ifdef(DEBUG). @@ -32,6 +32,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, + mixed/1, simple/1, complicated/1, heavy/1, simple_all_keys/1, info/1]). -export([init_per_testcase/2, end_per_testcase/2]). -export([other_process/2]). @@ -47,7 +48,8 @@ end_per_testcase(_Case, Config) -> suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [simple, complicated, heavy, simple_all_keys, info]. + [simple, complicated, heavy, simple_all_keys, info, + mixed]. groups() -> []. @@ -369,3 +371,60 @@ match_keys(All) -> Ks = lists:sort([K||{K,_}<-All]), Ks = lists:sort(erlang:get_keys()), ok. + + +%% Do random mixed put/erase to test grow/shrink +%% Written for a temporary bug in gc during shrink +mixed(_Config) -> + Rand0 = rand:seed_s(exsplus), + io:format("Random seed = ~p\n\n", [rand:export_seed_s(Rand0)]), + + erts_debug:set_internal_state(available_internal_state, true), + try + C = do_mixed([10,0,100,50,1000,500,600,100,150,1,11,2,30,0], + 0, + array:new(), + 1, + Rand0), + io:format("\nDid total of ~p operations\n", [C]) + after + erts_debug:set_internal_state(available_internal_state, false) + end. + +do_mixed([], _, _, C, _) -> + C; +do_mixed([GoalN | Tail], GoalN, Array, C, Rand0) -> + io:format("Reached goal of ~p keys in dict after ~p mixed ops\n",[GoalN, C]), + GoalN = array:size(Array), + do_mixed(Tail, GoalN, Array, C, Rand0); +do_mixed([GoalN | _]=Goals, CurrN, Array0, C, Rand0) -> + CurrN = array:size(Array0), + GrowPercent = case GoalN > CurrN of + true when CurrN == 0 -> 100; + true -> 75; + false -> 25 + end, + {R, Rand1} = rand:uniform_s(100, Rand0), + case R of + _ when R =< GrowPercent -> %%%%%%%%%%%%% GROW + {Key, Rand2} = rand:uniform_s(10000, Rand1), + case put(Key, {Key,C}) of + undefined -> + Array1 = array:set(CurrN, Key, Array0), + do_mixed(Goals, CurrN+1, Array1, C+1, Rand2); + _ -> + do_mixed(Goals, CurrN, Array0, C+1, Rand2) + end; + + _ -> %%%%%%%%%% SHRINK + {Kix, Rand2} = rand:uniform_s(CurrN, Rand1), + Key = array:get(Kix-1, Array0), + + %% provoke GC during shrink + erts_debug:set_internal_state(fill_heap, true), + + {Key, _} = erase(Key), + Array1 = array:set(Kix-1, array:get(CurrN-1, Array0), Array0), + Array2 = array:resize(CurrN-1, Array1), + do_mixed(Goals, CurrN-1, Array2, C+1, Rand2) + end. diff --git a/lib/kernel/test/pg2_SUITE.erl b/lib/kernel/test/pg2_SUITE.erl index 832d2d1c27..6e4f5ee682 100644 --- a/lib/kernel/test/pg2_SUITE.erl +++ b/lib/kernel/test/pg2_SUITE.erl @@ -21,7 +21,7 @@ %%----------------------------------------------------------------- -module(pg2_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(datadir, ?config(data_dir, Config)). -define(privdir, ?config(priv_dir, Config)). diff --git a/lib/kernel/test/prim_file_SUITE.erl b/lib/kernel/test/prim_file_SUITE.erl index 3e6d8492f7..1265180354 100644 --- a/lib/kernel/test/prim_file_SUITE.erl +++ b/lib/kernel/test/prim_file_SUITE.erl @@ -62,7 +62,7 @@ -export([allocate/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). -define(PRIM_FILE, prim_file). @@ -455,10 +455,7 @@ open1(Config) when is_list(Config) -> ?line ?PRIM_FILE:write(Fd1,Str), ?line {ok,0} = ?PRIM_FILE:position(Fd1,bof), ?line {ok, Str} = ?PRIM_FILE:read(Fd1,Length), - ?line case ?PRIM_FILE:read(Fd2,Length) of - {ok,Str} -> Str; - eof -> Str - end, + ?line {ok, Str} = ?PRIM_FILE:read(Fd2,Length), ?line ok = ?PRIM_FILE:close(Fd2), ?line {ok,0} = ?PRIM_FILE:position(Fd1,bof), ?line ok = ?PRIM_FILE:truncate(Fd1), @@ -1629,7 +1626,7 @@ e_rename(Config) when is_list(Config) -> %% successfully move a file to %% another drive. ok; - {unix, _ } -> + _ -> OtherFs = "/tmp", ?line NameOnOtherFs = filename:join(OtherFs, @@ -1653,10 +1650,7 @@ e_rename(Config) when is_list(Config) -> Else -> Else end, - Com; - {ose, _} -> - %% disabled for now - ok + Com end, ?line test_server:timetrap_cancel(Dog), Comment. diff --git a/lib/kernel/test/ram_file_SUITE.erl b/lib/kernel/test/ram_file_SUITE.erl index 933dc88d21..fdb61a3619 100644 --- a/lib/kernel/test/ram_file_SUITE.erl +++ b/lib/kernel/test/ram_file_SUITE.erl @@ -28,7 +28,7 @@ truncate/1, sync/1, get_set_file/1, compress/1, uuencode/1, large_file_errors/1, large_file_light/1, large_file_heavy/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). -define(FILE_MODULE, file). % Name of module to test diff --git a/lib/kernel/test/rpc_SUITE.erl b/lib/kernel/test/rpc_SUITE.erl index ed30c2dffa..42c522b1bd 100644 --- a/lib/kernel/test/rpc_SUITE.erl +++ b/lib/kernel/test/rpc_SUITE.erl @@ -28,7 +28,7 @@ -export([suicide/2, suicide/3, f/0, f2/0]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/kernel/test/seq_trace_SUITE.erl b/lib/kernel/test/seq_trace_SUITE.erl index 7df0bc3d2f..fb6f62d2e5 100644 --- a/lib/kernel/test/seq_trace_SUITE.erl +++ b/lib/kernel/test/seq_trace_SUITE.erl @@ -33,7 +33,12 @@ do_match_set_seq_token/1, do_gc_seq_token/1, countdown_start/2]). %-define(line_trace, 1). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). + +-define(TIMESTAMP_MODES, [no_timestamp, + timestamp, + monotonic_timestamp, + strict_monotonic_timestamp]). -define(default_timeout, ?t:minutes(1)). @@ -75,6 +80,17 @@ end_per_testcase(_Case, Config) -> token_set_get(doc) -> []; token_set_get(suite) -> []; 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). + +do_token_set_get(TsType) -> + io:format("Testing ~p~n", [TsType]), + Flags = case TsType of + timestamp -> 15; + strict_monotonic_timestamp -> 23; + monotonic_timestamp -> 39 + end, ?line Self = self(), ?line seq_trace:reset_trace(), %% Test that initial seq_trace is disabled @@ -88,22 +104,22 @@ token_set_get(Config) when is_list(Config) -> ?line {send,true} = seq_trace:get_token(send), ?line false = seq_trace:set_token('receive',true), ?line {'receive',true} = seq_trace:get_token('receive'), - ?line false = seq_trace:set_token(timestamp,true), - ?line {timestamp,true} = seq_trace:get_token(timestamp), + ?line false = seq_trace:set_token(TsType,true), + ?line {TsType,true} = seq_trace:get_token(TsType), %% Check the whole token - ?line {15,17,0,Self,0} = seq_trace:get_token(), % all flags are set + ?line {Flags,17,0,Self,0} = seq_trace:get_token(), % all flags are set %% Test setting and reading the 'serial' field ?line {0,0} = seq_trace:set_token(serial,{3,5}), ?line {serial,{3,5}} = seq_trace:get_token(serial), %% Check the whole token, test that a whole token can be set and get - ?line {15,17,5,Self,3} = seq_trace:get_token(), - ?line seq_trace:set_token({15,19,7,Self,5}), - ?line {15,19,7,Self,5} = seq_trace:get_token(), + ?line {Flags,17,5,Self,3} = seq_trace:get_token(), + ?line seq_trace:set_token({Flags,19,7,Self,5}), + ?line {Flags,19,7,Self,5} = seq_trace:get_token(), %% Check that receive timeout does not reset token ?line receive after 0 -> ok end, - ?line {15,19,7,Self,5} = seq_trace:get_token(), + ?line {Flags,19,7,Self,5} = seq_trace:get_token(), %% Check that token can be unset - ?line {15,19,7,Self,5} = seq_trace:set_token([]), + ?line {Flags,19,7,Self,5} = seq_trace:set_token([]), ?line [] = seq_trace:get_token(), %% Check that Previous serial counter survived unset token ?line 0 = seq_trace:set_token(label, 17), @@ -139,30 +155,42 @@ tracer_set_get(Config) when is_list(Config) -> print(doc) -> []; print(suite) -> []; print(Config) when is_list(Config) -> + lists:foreach(fun do_print/1, ?TIMESTAMP_MODES). + +do_print(TsType) -> ?line start_tracer(), - ?line seq_trace:set_token(print,true), + ?line set_token_flags([print, TsType]), ?line seq_trace:print(0,print1), ?line seq_trace:print(1,print2), ?line seq_trace:print(print3), ?line seq_trace:reset_trace(), - ?line [{0,{print,_,_,[],print1}}, - {0,{print,_,_,[],print3}}] = stop_tracer(2). + ?line [{0,{print,_,_,[],print1}, Ts0}, + {0,{print,_,_,[],print3}, Ts1}] = stop_tracer(2), + check_ts(TsType, Ts0), + check_ts(TsType, Ts1). send(doc) -> []; send(suite) -> []; send(Config) when is_list(Config) -> + lists:foreach(fun do_send/1, ?TIMESTAMP_MODES). + +do_send(TsType) -> ?line seq_trace:reset_trace(), ?line start_tracer(), ?line Receiver = spawn(?MODULE,one_time_receiver,[]), - ?line seq_trace:set_token(send,true), + ?line set_token_flags([send, TsType]), ?line Receiver ! send, ?line Self = self(), ?line seq_trace:reset_trace(), - ?line [{0,{send,_,Self,Receiver,send}}] = stop_tracer(1). + ?line [{0,{send,_,Self,Receiver,send}, Ts}] = stop_tracer(1), + check_ts(TsType, Ts). distributed_send(doc) -> []; distributed_send(suite) -> []; distributed_send(Config) when is_list(Config) -> + lists:foreach(fun do_distributed_send/1, ?TIMESTAMP_MODES). + +do_distributed_send(TsType) -> ?line {ok,Node} = start_node(seq_trace_other,[]), ?line {_,Dir} = code:is_loaded(?MODULE), ?line Mdir = filename:dirname(Dir), @@ -170,30 +198,39 @@ distributed_send(Config) when is_list(Config) -> ?line seq_trace:reset_trace(), ?line start_tracer(), ?line Receiver = spawn(Node,?MODULE,one_time_receiver,[]), - ?line seq_trace:set_token(send,true), + ?line set_token_flags([send,TsType]), ?line Receiver ! send, ?line Self = self(), ?line seq_trace:reset_trace(), ?line stop_node(Node), - ?line [{0,{send,_,Self,Receiver,send}}] = stop_tracer(1). + ?line [{0,{send,_,Self,Receiver,send}, Ts}] = stop_tracer(1), + check_ts(TsType, Ts). + recv(doc) -> []; recv(suite) -> []; recv(Config) when is_list(Config) -> + lists:foreach(fun do_recv/1, ?TIMESTAMP_MODES). + +do_recv(TsType) -> ?line seq_trace:reset_trace(), ?line start_tracer(), ?line Receiver = spawn(?MODULE,one_time_receiver,[]), - ?line seq_trace:set_token('receive',true), + ?line set_token_flags(['receive',TsType]), ?line Receiver ! 'receive', %% let the other process receive the message: ?line receive after 1 -> ok end, ?line Self = self(), ?line seq_trace:reset_trace(), - ?line [{0,{'receive',_,Self,Receiver,'receive'}}] = stop_tracer(1). + ?line [{0,{'receive',_,Self,Receiver,'receive'}, Ts}] = stop_tracer(1), + check_ts(TsType, Ts). distributed_recv(doc) -> []; distributed_recv(suite) -> []; distributed_recv(Config) when is_list(Config) -> + lists:foreach(fun do_distributed_recv/1, ?TIMESTAMP_MODES). + +do_distributed_recv(TsType) -> ?line {ok,Node} = start_node(seq_trace_other,[]), ?line {_,Dir} = code:is_loaded(?MODULE), ?line Mdir = filename:dirname(Dir), @@ -201,7 +238,7 @@ distributed_recv(Config) when is_list(Config) -> ?line seq_trace:reset_trace(), ?line rpc:call(Node,?MODULE,start_tracer,[]), ?line Receiver = spawn(Node,?MODULE,one_time_receiver,[]), - ?line seq_trace:set_token('receive',true), + ?line set_token_flags(['receive',TsType]), ?line Receiver ! 'receive', %% let the other process receive the message: ?line receive after 1 -> ok end, @@ -210,16 +247,20 @@ distributed_recv(Config) when is_list(Config) -> ?line Result = rpc:call(Node,?MODULE,stop_tracer,[1]), ?line stop_node(Node), ?line ok = io:format("~p~n",[Result]), - ?line [{0,{'receive',_,Self,Receiver,'receive'}}] = Result. + ?line [{0,{'receive',_,Self,Receiver,'receive'}, Ts}] = Result, + check_ts(TsType, Ts). trace_exit(doc) -> []; trace_exit(suite) -> []; trace_exit(Config) when is_list(Config) -> + lists:foreach(fun do_trace_exit/1, ?TIMESTAMP_MODES). + +do_trace_exit(TsType) -> ?line seq_trace:reset_trace(), ?line start_tracer(), ?line Receiver = spawn_link(?MODULE, one_time_receiver, [exit]), ?line process_flag(trap_exit, true), - ?line seq_trace:set_token(send,true), + ?line set_token_flags([send, TsType]), ?line Receiver ! {before, exit}, %% let the other process receive the message: ?line receive @@ -233,13 +274,18 @@ trace_exit(Config) when is_list(Config) -> ?line Result = stop_tracer(2), ?line seq_trace:reset_trace(), ?line ok = io:format("~p~n", [Result]), - ?line [{0, {send, {0,1}, Self, Receiver, {before, exit}}}, + ?line [{0, {send, {0,1}, Self, Receiver, {before, exit}}, Ts0}, {0, {send, {1,2}, Receiver, Self, - {'EXIT', Receiver, {exit, {before, exit}}}}}] = Result. + {'EXIT', Receiver, {exit, {before, exit}}}}, Ts1}] = Result, + check_ts(TsType, Ts0), + check_ts(TsType, Ts1). distributed_exit(doc) -> []; distributed_exit(suite) -> []; distributed_exit(Config) when is_list(Config) -> + lists:foreach(fun do_distributed_exit/1, ?TIMESTAMP_MODES). + +do_distributed_exit(TsType) -> ?line {ok, Node} = start_node(seq_trace_other, []), ?line {_, Dir} = code:is_loaded(?MODULE), ?line Mdir = filename:dirname(Dir), @@ -248,7 +294,7 @@ distributed_exit(Config) when is_list(Config) -> ?line rpc:call(Node, ?MODULE, start_tracer,[]), ?line Receiver = spawn_link(Node, ?MODULE, one_time_receiver, [exit]), ?line process_flag(trap_exit, true), - ?line seq_trace:set_token(send, true), + ?line set_token_flags([send, TsType]), ?line Receiver ! {before, exit}, %% let the other process receive the message: ?line receive @@ -264,7 +310,8 @@ distributed_exit(Config) when is_list(Config) -> ?line stop_node(Node), ?line ok = io:format("~p~n", [Result]), ?line [{0, {send, {1, 2}, Receiver, Self, - {'EXIT', Receiver, {exit, {before, exit}}}}}] = Result. + {'EXIT', Receiver, {exit, {before, exit}}}}, Ts}] = Result, + check_ts(TsType, Ts). call(doc) -> "Tests special forms {is_seq_trace} and {get_seq_token} " @@ -361,14 +408,22 @@ port(doc) -> "Send trace messages to a port."; port(suite) -> []; port(Config) when is_list(Config) -> + lists:foreach(fun (TsType) -> do_port(TsType, Config) end, + ?TIMESTAMP_MODES). + +do_port(TsType, Config) -> + io:format("Testing ~p~n",[TsType]), ?line Port = load_tracer(Config), ?line seq_trace:set_system_tracer(Port), - ?line seq_trace:set_token(print, true), + ?line set_token_flags([print, TsType]), ?line Small = [small,term], ?line seq_trace:print(0, Small), ?line case get_port_message(Port) of - {seq_trace,0,{print,_,_,[],Small}} -> + {seq_trace,0,{print,_,_,[],Small}} when TsType == no_timestamp -> + ok; + {seq_trace,0,{print,_,_,[],Small},Ts0} when TsType /= no_timestamp -> + check_ts(TsType, Ts0), ok; Other -> ?line seq_trace:reset_trace(), @@ -382,7 +437,10 @@ port(Config) when is_list(Config) -> ?line seq_trace:print(0, OtherSmall), ?line seq_trace:reset_trace(), ?line case get_port_message(Port) of - {seq_trace,0,{print,_,_,[],OtherSmall}} -> + {seq_trace,0,{print,_,_,[],OtherSmall}} when TsType == no_timestamp -> + ok; + {seq_trace,0,{print,_,_,[],OtherSmall}, Ts1} when TsType /= no_timestamp -> + check_ts(TsType, Ts1), ok; Other1 -> ?line ?t:fail({unexpected,Other1}) @@ -399,6 +457,8 @@ port(Config) when is_list(Config) -> Other2 -> ?line ?t:fail({unexpected,Other2}) end, + unlink(Port), + exit(Port,kill), ok. get_port_message(Port) -> @@ -734,7 +794,7 @@ simple_tracer(Data, DN) -> {seq_trace,Label,Info,Ts} -> simple_tracer([{Label,Info,Ts}|Data], DN+1); {seq_trace,Label,Info} -> - simple_tracer([{Label,Info}|Data], DN+1); + simple_tracer([{Label,Info, no_timestamp}|Data], DN+1); {stop,N,From} when DN >= N -> From ! {tracerlog,lists:reverse(Data)} end. @@ -759,7 +819,55 @@ start_tracer() -> seq_trace:set_system_tracer(Pid), Pid. - + +set_token_flags([]) -> + ok; +set_token_flags([no_timestamp|Flags]) -> + seq_trace:set_token(timestamp, false), + seq_trace:set_token(monotonic_timestamp, false), + seq_trace:set_token(strict_monotonic_timestamp, false), + set_token_flags(Flags); +set_token_flags([Flag|Flags]) -> + seq_trace:set_token(Flag, true), + set_token_flags(Flags). + +check_ts(no_timestamp, Ts) -> + try + no_timestamp = Ts + catch + _ : _ -> + ?t:fail({unexpected_timestamp, Ts}) + end, + ok; +check_ts(timestamp, Ts) -> + try + {Ms,S,Us} = Ts, + true = is_integer(Ms), + true = is_integer(S), + true = is_integer(Us) + catch + _ : _ -> + ?t:fail({unexpected_timestamp, Ts}) + end, + ok; +check_ts(monotonic_timestamp, Ts) -> + try + true = is_integer(Ts) + catch + _ : _ -> + ?t:fail({unexpected_timestamp, Ts}) + end, + ok; +check_ts(strict_monotonic_timestamp, Ts) -> + try + {MT, UMI} = Ts, + true = is_integer(MT), + true = is_integer(UMI) + catch + _ : _ -> + ?t:fail({unexpected_timestamp, Ts}) + end, + ok. start_node(Name, Param) -> test_server:start_node(Name, slave, [{args, Param}]). diff --git a/lib/kernel/test/wrap_log_reader_SUITE.erl b/lib/kernel/test/wrap_log_reader_SUITE.erl index 9a93b9037f..27ff98dc17 100644 --- a/lib/kernel/test/wrap_log_reader_SUITE.erl +++ b/lib/kernel/test/wrap_log_reader_SUITE.erl @@ -29,7 +29,7 @@ -define(config(X,Y), foo). -define(t,test_server). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(format(S, A), ok). -define(privdir(Conf), ?config(priv_dir, Conf)). -endif. diff --git a/lib/kernel/test/zlib_SUITE.erl b/lib/kernel/test/zlib_SUITE.erl index 6aaa024a82..d9d4c138d5 100644 --- a/lib/kernel/test/zlib_SUITE.erl +++ b/lib/kernel/test/zlib_SUITE.erl @@ -20,7 +20,7 @@ -module(zlib_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -compile(export_all). @@ -912,7 +912,7 @@ smp(Config) -> FnAList = lists:map(fun(F) -> {F,?MODULE:F({get_arg,Config})} end, Funcs), - Pids = [spawn_link(?MODULE, worker, [random:uniform(9999), + Pids = [spawn_link(?MODULE, worker, [rand:uniform(9999), list_to_tuple(FnAList), self()]) || _ <- lists:seq(1,NumOfProcs)], @@ -925,7 +925,7 @@ smp(Config) -> worker(Seed, FnATpl, Parent) -> io:format("smp worker ~p, seed=~p~n",[self(),Seed]), - random:seed(Seed,Seed,Seed), + rand:seed(exsplus, {Seed,Seed,Seed}), worker_loop(100, FnATpl), Parent ! self(). @@ -933,7 +933,7 @@ worker_loop(0, _FnATpl) -> large_deflate_do(), % the time consuming one as finale ok; worker_loop(N, FnATpl) -> - {F,A} = element(random:uniform(size(FnATpl)),FnATpl), + {F,A} = element(rand:uniform(tuple_size(FnATpl)), FnATpl), ?MODULE:F(A), worker_loop(N-1, FnATpl). diff --git a/lib/megaco/test/Makefile b/lib/megaco/test/Makefile index 06ecc06d20..d621b0f16d 100644 --- a/lib/megaco/test/Makefile +++ b/lib/megaco/test/Makefile @@ -100,10 +100,7 @@ ifeq ($(USE_MEGACO_HIPE),true) ERL_COMPILE_FLAGS += +native -Dmegaco_hipe_special=true endif -ERL_COMPILE_FLAGS += \ - $(MEGACO_ERL_COMPILE_FLAGS) \ - -pa $(ERL_TOP)/lib/test_server/ebin \ - -I$(ERL_TOP)/lib/test_server/include +ERL_COMPILE_FLAGS += $(MEGACO_ERL_COMPILE_FLAGS) ERL_PATH = -pa ../../megaco/examples/simple \ -pa ../../megaco/ebin \ diff --git a/lib/mnesia/src/mnesia_bup.erl b/lib/mnesia/src/mnesia_bup.erl index 1f150ae38b..8b1143a352 100644 --- a/lib/mnesia/src/mnesia_bup.erl +++ b/lib/mnesia/src/mnesia_bup.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. 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. @@ -112,7 +112,7 @@ iter(R, Header, Schema, Fun, Acc, BupItems) -> safe_apply(R, write, [_, Items]) when Items =:= [] -> R; safe_apply(R, What, Args) -> - Abort = fun(Re) -> abort_restore(R, What, Args, Re) end, + Abort = abort_restore_fun(R, What, Args), Mod = R#restore.bup_module, try apply(Mod, What, Args) of {ok, Opaque, Items} when What =:= read -> @@ -127,6 +127,10 @@ safe_apply(R, What, Args) -> Abort(Re) end. +-spec abort_restore_fun(_, _, _) -> fun((_) -> no_return()). +abort_restore_fun(R, What, Args) -> + fun(Re) -> abort_restore(R, What, Args, Re) end. + abort_restore(R = #restore{bup_module=Mod}, What, Args, Reason) -> dbg_out("Restore aborted. ~p:~p~p -> ~p~n", [Mod, What, Args, Reason]), diff --git a/lib/mnesia/src/mnesia_controller.erl b/lib/mnesia/src/mnesia_controller.erl index 02c175760e..69ccc1d2c9 100644 --- a/lib/mnesia/src/mnesia_controller.erl +++ b/lib/mnesia/src/mnesia_controller.erl @@ -78,7 +78,7 @@ change_table_majority/1, del_active_replica/2, wait_for_tables/2, - get_network_copy/2, + get_network_copy/3, merge_schema/0, start_remote_sender/4, schedule_late_disc_load/2 @@ -329,14 +329,14 @@ release_schema_commit_lock() -> unlink(whereis(?SERVER_NAME)). %% Special for preparation of add table copy -get_network_copy(Tab, Cs) -> +get_network_copy(Tid, Tab, Cs) -> % We can't let the controller queue this one % because that may cause a deadlock between schema_operations % and initial tableloadings which both takes schema locks. % But we have to get copier_done msgs when the other side % goes down. call({add_other, self()}), - Reason = {dumper,add_table_copy}, + Reason = {dumper,{add_table_copy, Tid}}, Work = #net_load{table = Tab,reason = Reason,cstruct = Cs}, %% I'll need this cause it's linked trough the subscriber %% might be solved by using monitor in subscr instead. @@ -775,7 +775,7 @@ handle_call({net_load, Tab, Cs}, From, State) -> true -> Worker = #net_load{table = Tab, opt_reply_to = From, - reason = {dumper,add_table_copy}, + reason = {dumper,{add_table_copy, unknown}}, cstruct = Cs }, add_worker(Worker, State); @@ -1180,11 +1180,11 @@ handle_info(Done = #loader_done{worker_pid=WPid, table_name=Tab}, State0) -> Done#loader_done.needs_announce == true, Done#loader_done.needs_reply == true -> i_have_tab(Tab), - %% Should be {dumper,add_table_copy} only + %% Should be {dumper,{add_table_copy, _}} only reply(Done#loader_done.reply_to, Done#loader_done.reply); Done#loader_done.needs_reply == true -> - %% Should be {dumper,add_table_copy} only + %% Should be {dumper,{add_table_copy,_}} only reply(Done#loader_done.reply_to, Done#loader_done.reply); Done#loader_done.needs_announce == true, Tab == schema -> @@ -2148,6 +2148,10 @@ load_table_fun(#net_load{cstruct=Cs, table=Tab, reason=Reason, opt_reply_to=Repl reply_to = ReplyTo, reply = {loaded, ok} }, + AddTableCopy = case Reason of + {dumper,{add_table_copy,_}} -> true; + _ -> false + end, if ReadNode == node() -> %% Already loaded locally @@ -2157,7 +2161,7 @@ load_table_fun(#net_load{cstruct=Cs, table=Tab, reason=Reason, opt_reply_to=Repl Res = mnesia_loader:disc_load_table(Tab, load_local_content), Done#loader_done{reply = Res, needs_announce = true, needs_sync = true} end; - AccessMode == read_only, Reason /= {dumper,add_table_copy} -> + AccessMode == read_only, not AddTableCopy -> fun() -> disc_load_table(Tab, Reason, ReplyTo) end; true -> fun() -> diff --git a/lib/mnesia/src/mnesia_lib.erl b/lib/mnesia/src/mnesia_lib.erl index 77c7a7638d..a5eded4f0f 100644 --- a/lib/mnesia/src/mnesia_lib.erl +++ b/lib/mnesia/src/mnesia_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. 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. @@ -403,6 +403,7 @@ other_val_1(Var) -> _ -> error end. +-spec pr_other(_) -> no_return(). pr_other(Var) -> Why = case is_running() of @@ -921,20 +922,7 @@ random_time(Retries, _Counter0) -> UpperLimit = 500, Dup = Retries * Retries, MaxIntv = trunc(UpperLimit * (1-(50/((Dup)+50)))), - - case get(random_seed) of - undefined -> - _ = random:seed(erlang:unique_integer(), - erlang:monotonic_time(), - erlang:unique_integer()), - Time = Dup + random:uniform(MaxIntv), - %% dbg_out("---random_test rs ~w max ~w val ~w---~n", [Retries, MaxIntv, Time]), - Time; - _ -> - Time = Dup + random:uniform(MaxIntv), - %% dbg_out("---random_test rs ~w max ~w val ~w---~n", [Retries, MaxIntv, Time]), - Time - end. + Dup + rand:uniform(MaxIntv). report_system_event(Event0) -> Event = {mnesia_system_event, Event0}, diff --git a/lib/mnesia/src/mnesia_loader.erl b/lib/mnesia/src/mnesia_loader.erl index da8549be50..41fcd76fcb 100644 --- a/lib/mnesia/src/mnesia_loader.erl +++ b/lib/mnesia/src/mnesia_loader.erl @@ -180,8 +180,7 @@ do_get_disc_copy2(Tab, Reason, Storage, Type) when Storage == disc_only_copies - -define(MAX_RAM_TRANSFERS, (?MAX_RAM_FILE_SIZE div ?MAX_TRANSFER_SIZE) + 1). -define(MAX_NOPACKETS, 20). -net_load_table(Tab, Reason, Ns, Cs) - when Reason == {dumper,add_table_copy} -> +net_load_table(Tab, {dumper,{add_table_copy, _}}=Reason, Ns, Cs) -> try_net_load_table(Tab, Reason, Ns, Cs); net_load_table(Tab, Reason, Ns, _Cs) -> try_net_load_table(Tab, Reason, Ns, val({Tab, cstruct})). @@ -233,7 +232,8 @@ do_snmpify(Tab, Us, Storage) -> set({Tab, {index, snmp}}, Snmp). %% Start the recieiver -init_receiver(Node, Tab, Storage, Cs, Reas={dumper,add_table_copy}) -> +init_receiver(Node, Tab, Storage, Cs, Reas={dumper,{add_table_copy, Tid}}) -> + rpc:call(Node, mnesia_lib, set, [{?MODULE, active_trans}, Tid]), case start_remote_sender(Node, Tab, Storage) of {SenderPid, TabSize, DetsData} -> start_receiver(Tab,Storage,Cs,SenderPid,TabSize,DetsData,Reas); @@ -307,7 +307,7 @@ table_init_fun(SenderPid) -> end. %% Add_table_copy get's it's own locks. -start_receiver(Tab,Storage,Cs,SenderPid,TabSize,DetsData,{dumper,add_table_copy}) -> +start_receiver(Tab,Storage,Cs,SenderPid,TabSize,DetsData,{dumper,{add_table_copy,_}}) -> Init = table_init_fun(SenderPid), case do_init_table(Tab,Storage,Cs,SenderPid,TabSize,DetsData,self(), Init) of Err = {error, _} -> @@ -658,9 +658,10 @@ send_table(Pid, Tab, RemoteS) -> {Init, Chunk} = reader_funcs(UseDetsChunk, Tab, Storage, KeysPerTransfer), SendIt = fun() -> - {atomic, ok} = prepare_copy(Pid, Tab, Storage), + NeedLock = need_lock(Tab), + {atomic, ok} = prepare_copy(Pid, Tab, Storage, NeedLock), send_more(Pid, 1, Chunk, Init(), Tab), - finish_copy(Pid, Tab, Storage, RemoteS) + finish_copy(Pid, Tab, Storage, RemoteS, NeedLock) end, try SendIt() of @@ -678,10 +679,10 @@ send_table(Pid, Tab, RemoteS) -> end end. -prepare_copy(Pid, Tab, Storage) -> +prepare_copy(Pid, Tab, Storage, NeedLock) -> Trans = fun() -> - mnesia:lock_table(Tab, load), + NeedLock andalso mnesia:lock_table(Tab, load), mnesia_subscr:subscribe(Pid, {table, Tab}), update_where_to_write(Tab, node(Pid)), mnesia_lib:db_fixtable(Storage, Tab, true), @@ -689,6 +690,21 @@ prepare_copy(Pid, Tab, Storage) -> end, mnesia:transaction(Trans). + +need_lock(Tab) -> + case ?catch_val({?MODULE, active_trans}) of + #tid{} = Tid -> + %% move_table_copy grabs it's own table-lock + %% do not deadlock with it + mnesia_lib:unset({?MODULE, active_trans}), + case mnesia_locker:get_held_locks(Tab) of + [{write, Tid}|_] -> false; + _Locks -> true + end; + _ -> + true + end. + update_where_to_write(Tab, Node) -> case val({Tab, access_mode}) of read_only -> @@ -783,12 +799,12 @@ send_packet(N, Pid, Chunk, {Recs, Cont}) when N < ?MAX_NOPACKETS -> send_packet(_N, _Pid, _Chunk, DataState) -> DataState. -finish_copy(Pid, Tab, Storage, RemoteS) -> +finish_copy(Pid, Tab, Storage, RemoteS, NeedLock) -> RecNode = node(Pid), DatBin = dat2bin(Tab, Storage, RemoteS), Trans = fun() -> - mnesia:read_lock_table(Tab), + NeedLock andalso mnesia:read_lock_table(Tab), A = val({Tab, access_mode}), mnesia_controller:sync_and_block_table_whereabouts(Tab, RecNode, RemoteS, A), cleanup_tab_copier(Pid, Storage, Tab), diff --git a/lib/mnesia/src/mnesia_locker.erl b/lib/mnesia/src/mnesia_locker.erl index 89feeba2c3..5766f22e92 100644 --- a/lib/mnesia/src/mnesia_locker.erl +++ b/lib/mnesia/src/mnesia_locker.erl @@ -22,7 +22,7 @@ -module(mnesia_locker). -export([ - get_held_locks/0, + get_held_locks/0, get_held_locks/1, get_lock_queue/0, global_lock/5, ixrlock/5, @@ -236,6 +236,11 @@ loop(State) -> From ! {Ref, ok}, loop(State); + {From, {is_locked, Oid}} -> + Held = ?ets_lookup(mnesia_held_locks, Oid), + reply(From, Held), + loop(State); + {'EXIT', Pid, _} when Pid == State#state.supervisor -> do_stop(); @@ -1151,6 +1156,19 @@ get_held_locks() -> Locks = receive {mnesia_held_locks, Ls} -> Ls after 5000 -> [] end, rewrite_locks(Locks, []). +%% Mnesia internal usage only +get_held_locks(Tab) when is_atom(Tab) -> + Oid = {Tab, ?ALL}, + ?MODULE ! {self(), {is_locked, Oid}}, + receive + {?MODULE, _Node, Locks} -> + case Locks of + [] -> []; + [{Oid, _Prev, What}] -> What + end + end. + + rewrite_locks([{Oid, _, Ls}|Locks], Acc0) -> Acc = rewrite_locks(Ls, Oid, Acc0), rewrite_locks(Locks, Acc); diff --git a/lib/mnesia/src/mnesia_log.erl b/lib/mnesia/src/mnesia_log.erl index 8b19e13ff6..36135418c8 100644 --- a/lib/mnesia/src/mnesia_log.erl +++ b/lib/mnesia/src/mnesia_log.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. 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. @@ -734,7 +734,7 @@ backup_schema(B, Tabs) -> safe_apply(B, write, [_, Items]) when Items == [] -> B; safe_apply(B, What, Args) -> - Abort = fun(R) -> abort_write(B, What, Args, R) end, + Abort = abort_write_fun(B, What, Args), receive {'EXIT', Pid, R} -> Abort({'EXIT', Pid, R}) after 0 -> @@ -746,6 +746,10 @@ safe_apply(B, What, Args) -> end end. +-spec abort_write_fun(_, _, _) -> fun((_) -> no_return()). +abort_write_fun(B, What, Args) -> + fun(R) -> abort_write(B, What, Args, R) end. + abort_write(B, What, Args, Reason) -> Mod = B#backup_args.module, Opaque = B#backup_args.opaque, diff --git a/lib/mnesia/src/mnesia_monitor.erl b/lib/mnesia/src/mnesia_monitor.erl index 8313c3bda5..081d746257 100644 --- a/lib/mnesia/src/mnesia_monitor.erl +++ b/lib/mnesia/src/mnesia_monitor.erl @@ -82,9 +82,9 @@ going_down = [], tm_started = false, early_connects = [], connecting, mq = [], remote_node_status = []}). --define(current_protocol_version, {8,1}). +-define(current_protocol_version, {8,2}). --define(previous_protocol_version, {8,0}). +-define(previous_protocol_version, {8,1}). start() -> gen_server:start_link({local, ?MODULE}, ?MODULE, @@ -193,7 +193,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, {7,6}]. + [protocol_version(), ?previous_protocol_version]. needs_protocol_conversion(Node) -> case {?catch_val({protocol, Node}), protocol_version()} of @@ -424,8 +424,6 @@ handle_call({negotiate_protocol, Mon, Version, Protocols}, From, State) case hd(Protocols) of ?previous_protocol_version -> accept_protocol(Mon, MyVersion, ?previous_protocol_version, From, State); - {7,6} -> - accept_protocol(Mon, MyVersion, {7,6}, From, State); _ -> verbose("Connection with ~p rejected. " "version = ~p, protocols = ~p, " diff --git a/lib/mnesia/src/mnesia_schema.erl b/lib/mnesia/src/mnesia_schema.erl index 593360415d..782493fb4f 100644 --- a/lib/mnesia/src/mnesia_schema.erl +++ b/lib/mnesia/src/mnesia_schema.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. 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. @@ -646,54 +646,18 @@ cs2list(Cs) when is_record(Cs, cstruct) -> rec2list(Tags, Tags, 2, Cs); cs2list(CreateList) when is_list(CreateList) -> CreateList; -%% 4.6 + +%% since 4.6 cs2list(Cs) when element(1, Cs) == cstruct, tuple_size(Cs) == 19 -> Tags = [name,type,ram_copies,disc_copies,disc_only_copies, load_order,access_mode,majority,index,snmp,local_content, record_name,attributes, user_properties,frag_properties,storage_properties, cookie,version], - rec2list(Tags, Tags, 2, Cs); -%% 4.4.19 -cs2list(Cs) when element(1, Cs) == cstruct, tuple_size(Cs) == 18 -> - Tags = [name,type,ram_copies,disc_copies,disc_only_copies, - load_order,access_mode,majority,index,snmp,local_content, - record_name,attributes,user_properties,frag_properties, - cookie,version], - rec2list(Tags, Tags, 2, Cs); -%% 4.4.18 and earlier -cs2list(Cs) when element(1, Cs) == cstruct, tuple_size(Cs) == 17 -> - Tags = [name,type,ram_copies,disc_copies,disc_only_copies, - load_order,access_mode,index,snmp,local_content, - record_name,attributes,user_properties,frag_properties, - cookie,version], rec2list(Tags, Tags, 2, Cs). cs2list(false, Cs) -> - cs2list(Cs); -cs2list(ver4_4_18, Cs) -> %% Or earlier - Orig = record_info(fields, cstruct), - Tags = [name,type,ram_copies,disc_copies,disc_only_copies, - load_order,access_mode,index,snmp,local_content, - record_name,attributes,user_properties,frag_properties, - cookie,version], - rec2list(Tags, Orig, 2, Cs); -cs2list(ver4_4_19, Cs) -> - Orig = record_info(fields, cstruct), - Tags = [name,type,ram_copies,disc_copies,disc_only_copies, - load_order,access_mode,majority,index,snmp,local_content, - record_name,attributes,user_properties,frag_properties, - cookie,version], - rec2list(Tags, Orig, 2, Cs); -cs2list(ver4_6, Cs) -> - Orig = record_info(fields, cstruct), - Tags = [name,type,ram_copies,disc_copies,disc_only_copies, - load_order,access_mode,majority,index,snmp,local_content, - record_name,attributes, - user_properties,frag_properties,storage_properties, - cookie,version], - rec2list(Tags, Orig, 2, Cs). - + cs2list(Cs). rec2list([Tag | Tags], [Tag | Orig], Pos, Rec) -> Val = element(Pos, Rec), @@ -703,19 +667,8 @@ rec2list([], _, _Pos, _Rec) -> rec2list(Tags, [_|Orig], Pos, Rec) -> rec2list(Tags, Orig, Pos+1, Rec). -normalize_cs(Cstructs, Node) -> - %% backward-compatibility hack; normalize before returning - case need_old_cstructs([Node]) of - false -> - Cstructs; - Version -> - %% some other format - [convert_cs(Version, Cs) || Cs <- Cstructs] - end. - -convert_cs(Version, Cs) -> - Fields = [Value || {_, Value} <- cs2list(Version, Cs)], - list_to_tuple([cstruct|Fields]). +normalize_cs(Cstructs, _Node) -> + Cstructs. list2cs(List) when is_list(List) -> Name = pick(unknown, name, List, must), @@ -1142,6 +1095,7 @@ do_delete_table(Tab) -> ensure_writable(schema), insert_schema_ops(TidTs, make_delete_table(Tab, whole_table)). +-dialyzer({no_improper_lists, make_delete_table/2}). make_delete_table(Tab, Mode) -> case existed_before(Tab) of false -> @@ -1297,6 +1251,7 @@ make_del_table_copy(Tab, Node) -> _ -> ensure_active(Cs), verify_cstruct(Cs2), + get_tid_ts_and_lock(Tab, write), [{op, del_table_copy, Storage, Node, vsn_cs2list(Cs2)}] end. @@ -1324,6 +1279,7 @@ remove_node_from_tabs([Tab|Rest], Node) -> remove_node_from_tabs(Rest, Node)]; _Ns -> verify_cstruct(Cs2), + get_tid_ts_and_lock(Tab, write), [{op, del_table_copy, ram_copies, Node, vsn_cs2list(Cs2)}| remove_node_from_tabs(Rest, Node)] end @@ -1355,6 +1311,11 @@ do_move_table(schema, _FromNode, _ToNode) -> mnesia:abort({bad_type, schema}); do_move_table(Tab, FromNode, ToNode) when is_atom(FromNode), is_atom(ToNode) -> TidTs = get_tid_ts_and_lock(schema, write), + AnyOld = lists:any(fun(Node) -> mnesia_monitor:needs_protocol_conversion(Node) end, + [ToNode|val({Tab, where_to_write})]), + if AnyOld -> ignore; %% Leads to deadlock on old nodes + true -> get_tid_ts_and_lock(Tab, write) + end, insert_schema_ops(TidTs, make_move_table(Tab, FromNode, ToNode)); do_move_table(Tab, FromNode, ToNode) -> mnesia:abort({badarg, Tab, FromNode, ToNode}). @@ -1962,7 +1923,7 @@ prepare_op(Tid, {op, add_table_copy, Storage, Node, TabDef}, _WaitFor) -> end, %% Tables are created by mnesia_loader get_network code insert_cstruct(Tid, Cs, true), - case mnesia_controller:get_network_copy(Tab, Cs) of + case mnesia_controller:get_network_copy(Tid, Tab, Cs) of {loaded, ok} -> {true, optional}; {not_loaded, ErrReason} -> @@ -1993,28 +1954,11 @@ prepare_op(Tid, {op, add_table_copy, Storage, Node, TabDef}, _WaitFor) -> {true, optional} end; -prepare_op(Tid, {op, del_table_copy, _Storage, Node, TabDef}, _WaitFor) -> +prepare_op(_Tid, {op, del_table_copy, _Storage, Node, TabDef}, _WaitFor) -> Cs = list2cs(TabDef), Tab = Cs#cstruct.name, - - if - %% Schema table lock is always required to run a schema op. - %% No need to look it. - node(Tid#tid.pid) == node(), Tab /= schema -> - Self = self(), - Pid = spawn_link(fun() -> lock_del_table(Tab, Node, Cs, Self) end), - put(mnesia_lock, Pid), - receive - {Pid, updated} -> - {true, optional}; - {Pid, FailReason} -> - mnesia:abort(FailReason); - {'EXIT', Pid, Reason} -> - mnesia:abort(Reason) - end; - true -> - {true, optional} - end; + set_where_to_read(Tab, Node, Cs), + {true, optional}; prepare_op(_Tid, {op, change_table_copy_type, N, FromS, ToS, TabDef}, _WaitFor) when N == node() -> @@ -2228,46 +2172,6 @@ receive_sync(Nodes, Pids) -> {abort, Else} end. -lock_del_table(Tab, NewNode, Cs0, Father) -> - Ns = val({schema, active_replicas}), - process_flag(trap_exit,true), - Lock = fun() -> - mnesia:write_lock_table(Tab), - %% Sigh using cs record - Set = fun(Node) -> - [Cs] = normalize_cs([Cs0], Node), - rpc:call(Node, ?MODULE, set_where_to_read, [Tab, NewNode, Cs]) - end, - Res = [Set(Node) || Node <- Ns], - Filter = fun(ok) -> - false; - ({badrpc, {'EXIT', {undef, _}}}) -> - %% This will be the case we talks with elder nodes - %% than 3.8.2, they will set where_to_read without - %% getting a lock. - false; - (_) -> - true - end, - case lists:filter(Filter, Res) of - [] -> - Father ! {self(), updated}, - %% When transaction is commited the process dies - %% and the lock is released. - receive _ -> ok end; - Err -> - Father ! {self(), {bad_commit, Err}} - end, - ok - end, - case mnesia:transaction(Lock) of - {atomic, ok} -> ok; - {aborted, R} -> Father ! {self(), R} - end, - unlink(Father), - unlink(whereis(mnesia_tm)), - exit(normal). - set_where_to_read(Tab, Node, Cs) -> case mnesia_lib:val({Tab, where_to_read}) of Node -> @@ -2418,13 +2322,19 @@ undo_prepare_op(Tid, {op, add_table_copy, Storage, Node, TabDef}) -> insert_cstruct(Tid, Cs2, true) % Don't care about the version end; -undo_prepare_op(_Tid, {op, del_table_copy, _, Node, TabDef}) - when Node == node() -> - WriteLocker = get(mnesia_lock), - WriteLocker =/= undefined andalso (WriteLocker ! die), +undo_prepare_op(_Tid, {op, del_table_copy, _, Node, TabDef}) -> Cs = list2cs(TabDef), Tab = Cs#cstruct.name, - mnesia_lib:set({Tab, where_to_read}, Node); + if node() =:= Node -> + mnesia_lib:set({Tab, where_to_read}, Node); + true -> + case mnesia_lib:val({Tab, where_to_read}) of + nowhere -> + mnesia_lib:set_remote_where_to_read(Tab); + _ -> + ignore + end + end; undo_prepare_op(_Tid, {op, change_table_copy_type, N, FromS, ToS, TabDef}) when N == node() -> @@ -2885,40 +2795,11 @@ do_merge_schema(LockTabs0) -> end. fetch_cstructs(Node) -> - case need_old_cstructs([Node]) of - false -> - rpc:call(Node, mnesia_controller, get_remote_cstructs, []); - _Ver -> - case rpc:call(Node, mnesia_controller, get_cstructs, []) of - {cstructs, Cs0, RR} -> - {cstructs, [list2cs(cs2list(Cs)) || Cs <- Cs0], RR}; - Err -> Err - end - end. + rpc:call(Node, mnesia_controller, get_remote_cstructs, []). -need_old_cstructs() -> - need_old_cstructs(val({schema, where_to_write})). - -need_old_cstructs(Nodes) -> - Filter = fun(Node) -> not mnesia_monitor:needs_protocol_conversion(Node) end, - case lists:dropwhile(Filter, Nodes) of - [] -> false; - [Node|_] -> - case rpc:call(Node, mnesia_lib, val, [{schema,cstruct}]) of - #cstruct{} -> - %% mnesia_lib:warning("Mnesia on ~p do not need to convert cstruct (~p)~n", - %% [node(), Node]), - false; - {badrpc, _} -> - need_old_cstructs(lists:delete(Node,Nodes)); - Cs when element(1, Cs) == cstruct, tuple_size(Cs) == 17 -> - ver4_4_18; % Without majority - Cs when element(1, Cs) == cstruct, tuple_size(Cs) == 18 -> - ver4_4_19; % With majority - Cs when element(1, Cs) == cstruct, tuple_size(Cs) == 19 -> - ver4_6 % With storage_properties - end - end. +need_old_cstructs() -> false. + +need_old_cstructs(_Nodes) -> false. tab_to_nodes(Tab) when is_atom(Tab) -> Cs = val({Tab, cstruct}), diff --git a/lib/mnesia/test/mnesia_consistency_test.erl b/lib/mnesia/test/mnesia_consistency_test.erl index 087aef86c9..279e7bc1ec 100644 --- a/lib/mnesia/test/mnesia_consistency_test.erl +++ b/lib/mnesia/test/mnesia_consistency_test.erl @@ -696,7 +696,7 @@ consistency_after_restore(ReplicaType, Op, Config) -> ?verify_mnesia(Nodes, []). change_tab(Father, Tab, Test) -> - Key = random:uniform(20), + Key = rand:uniform(20), Update = fun() -> case mnesia:read({Tab, Key}) of [{Tab, Key, 1}] -> diff --git a/lib/mnesia/test/mnesia_isolation_test.erl b/lib/mnesia/test/mnesia_isolation_test.erl index b66da6e390..4dd0c01d05 100644 --- a/lib/mnesia/test/mnesia_isolation_test.erl +++ b/lib/mnesia/test/mnesia_isolation_test.erl @@ -39,7 +39,7 @@ groups() -> [{locking, [], [no_conflict, simple_queue_conflict, advanced_queue_conflict, simple_deadlock_conflict, - advanced_deadlock_conflict, lock_burst, + advanced_deadlock_conflict, schema_deadlock, lock_burst, {group, sticky_locks}, {group, unbound_locking}, {group, admin_conflict}, nasty]}, {sticky_locks, [], [basic_sticky_functionality]}, @@ -148,20 +148,32 @@ simple_queue_conflict(Config) when is_list(Config) -> fun_loop(Fun, AllSharedLocks, OneExclusiveLocks), ok. -wait_for_lock(Pid, _Nodes, 0) -> +wait_for_lock(Pid, Nodes, Retry) -> + wait_for_lock(Pid, Nodes, Retry, queue). + +wait_for_lock(Pid, _Nodes, 0, queue) -> Queue = mnesia:system_info(lock_queue), ?error("Timeout while waiting for lock on Pid ~p in queue ~p~n", [Pid, Queue]); -wait_for_lock(Pid, Nodes, N) -> - rpc:multicall(Nodes, sys, get_status, [mnesia_locker]), - List = [rpc:call(Node, mnesia, system_info, [lock_queue]) || Node <- Nodes], +wait_for_lock(Pid, _Nodes, 0, held) -> + Held = mnesia:system_info(held_locks), + ?error("Timeout while waiting for lock on Pid ~p (held) ~p~n", [Pid, Held]); +wait_for_lock(Pid, Nodes, N, Where) -> + rpc:multicall(Nodes, sys, get_status, [mnesia_locker]), + List = case Where of + queue -> + [rpc:call(Node, mnesia, system_info, [lock_queue]) || Node <- Nodes]; + held -> + [rpc:call(Node, mnesia, system_info, [held_locks]) || Node <- Nodes] + end, Q = lists:append(List), - check_q(Pid, Q, Nodes, N). + check_q(Pid, Q, Nodes, N, Where). -check_q(Pid, [{_Oid, _Op, Pid, _Tid, _WFT} | _Tail], _N, _Count) -> ok; -check_q(Pid, [_ | Tail], N, Count) -> check_q(Pid, Tail, N, Count); -check_q(Pid, [], N, Count) -> - timer:sleep(500), - wait_for_lock(Pid, N, Count - 1). +check_q(Pid, [{_Oid, _Op, Pid, _Tid, _WFT} | _Tail], _N, _Count, _Where) -> ok; +check_q(Pid, [{_Oid, _Op, {tid,_,Pid}} | _Tail], _N, _Count, _Where) -> ok; +check_q(Pid, [_ | Tail], N, Count, Where) -> check_q(Pid, Tail, N, Count, Where); +check_q(Pid, [], N, Count, Where) -> + timer:sleep(200), + wait_for_lock(Pid, N, Count - 1, Where). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -270,6 +282,43 @@ advanced_deadlock_conflict(Config) when is_list(Config) -> ?match([], mnesia:system_info(lock_queue)), ok. +%% Verify (and regression test) deadlock in del_table_copy(schema, Node) +schema_deadlock(Config) when is_list(Config) -> + Ns = [Node1, Node2] = ?acquire_nodes(2, Config), + ?match({atomic, ok}, mnesia:create_table(a, [{disc_copies, Ns}])), + ?match({atomic, ok}, mnesia:create_table(b, [{disc_copies, Ns}])), + + Tester = self(), + + Deadlocker = fun() -> + mnesia:write({a,1,1}), %% grab write lock on A + receive + continue -> + mnesia:write({b,1,1}), %% grab write lock on B + end_trans + end + end, + + ?match(stopped, rpc:call(Node2, mnesia, stop, [])), + timer:sleep(500), %% Let Node1 reconfigure + sys:get_status(mnesia_monitor), + + DoingTrans = spawn_link(fun() -> Tester ! {self(),mnesia:transaction(Deadlocker)} end), + wait_for_lock(DoingTrans, [Node1], 10, held), + %% Will grab write locks on schema, a, and b + DoingSchema = spawn_link(fun() -> Tester ! {self(), mnesia:del_table_copy(schema, Node2)} end), + timer:sleep(500), %% Let schema trans start, and try to grab locks + DoingTrans ! continue, + + ?match(ok, receive {DoingTrans, {atomic, end_trans}} -> ok after 5000 -> timeout end), + ?match(ok, receive {DoingSchema, {atomic, ok}} -> ok after 5000 -> timeout end), + + sys:get_status(whereis(mnesia_locker)), % Explicit sync, release locks is async + ?match([], mnesia:system_info(held_locks)), + ?match([], mnesia:system_info(lock_queue)), + ok. + + one_oid(Tab) -> {Tab, 1}. other_oid(Tab) -> {Tab, 2}. diff --git a/lib/observer/doc/src/cdv.xml b/lib/observer/doc/src/cdv.xml index ee629bbd3f..df1032780a 100644 --- a/lib/observer/doc/src/cdv.xml +++ b/lib/observer/doc/src/cdv.xml @@ -4,7 +4,7 @@ <comref> <header> <copyright> - <year>2013</year> + <year>2003</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -33,16 +33,16 @@ <file>cdv.xml</file> </header> <com>cdv</com> - <comsummary>Script used for starting the Crashdump Viewer from the + <comsummary>Script to start the Crashdump Viewer from the OS command line. </comsummary> <description> - <p>The <c>cdv</c> shell script can be found under the <c>priv</c> - directory of the <c>observer</c> application. The script is used + <p>The <c>cdv</c> shell script is located in directory <c>priv</c> + of the Observer application. The script is used for starting the Crashdump Viewer tool from the OS command line.</p> - <p>For Windows users, <c>cdv.bat</c> can be found in the same + <p>For Windows users, <c>cdv.bat</c> is found in the same location.</p> </description> @@ -51,8 +51,8 @@ <name>cdv [file]</name> <fsummary>Start the Crashdump Viewer and load the given file.</fsummary> <desc> - <p>The <c>file</c> arguments is optional. If not given, a file - dialog will pop up allowing the user to select a crashdump + <p>Argument <c>file</c> is optional. If not specified, a file + dialog is displayed, allowing you to select a crashdump from the file system.</p> </desc> </func> diff --git a/lib/observer/doc/src/crashdump.xml b/lib/observer/doc/src/crashdump.xml index 76deee45f6..27e88d07e5 100644 --- a/lib/observer/doc/src/crashdump.xml +++ b/lib/observer/doc/src/crashdump.xml @@ -25,7 +25,7 @@ </legalnotice> <title>crashdump_viewer</title> - <prepared>Siri hansen</prepared> + <prepared>Siri Hansen</prepared> <responsible></responsible> <docno>1</docno> <approved></approved> @@ -41,32 +41,31 @@ <p>The Crashdump Viewer is a WxWidgets based tool for browsing Erlang crashdumps.</p> - <p>See the <seealso marker="crashdump_ug">user's guide</seealso> - for more information about how to get started with the Crashdump - Viewer.</p> + <p>For details about how to get started with the Crashdump Viewer, see the + <seealso marker="crashdump_ug"><c>User's Guide</c></seealso>.</p> </description> <funcs> <func> <name>start() -> ok</name> <name>start(File) -> ok</name> - <fsummary>Start the crashdump_viewer</fsummary> + <fsummary>Start the Crashdump Viewer.</fsummary> <type> <v>File = string()</v> - <d>The file name of the crashdump.</d> + <d>The filename of the crashdump.</d> </type> <desc> - <p>This function starts the <c>crashdump_viewer</c> GUI and - loads the given crashdump.</p> + <p>Starts the Crashdump Viewer GUI and + loads the specified crashdump.</p> - <p>If <c>File</c> is not given, a file dialog will be opened + <p>If <c>File</c> is not specified, a file dialog is opened where the crashdump can be selected.</p> </desc> </func> <func> <name>stop() -> ok</name> - <fsummary>Stop the crashdump_viewer</fsummary> + <fsummary>Terminate the Crashdump Viewer.</fsummary> <desc> - <p>This function stops the <c>crashdump_viewer</c> and closes + <p>Terminates the Crashdump Viewer and closes all GUI windows.</p> </desc> </func> diff --git a/lib/observer/doc/src/crashdump_ug.xml b/lib/observer/doc/src/crashdump_ug.xml index 4bb3628ab5..4ba057c3fb 100644 --- a/lib/observer/doc/src/crashdump_ug.xml +++ b/lib/observer/doc/src/crashdump_ug.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2003</year><year>2013</year> + <year>2003</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -39,371 +39,390 @@ <section> <title>Getting Started</title> - <p>The easiest way to start Crashdump Viewer is to use the - provided shell script named <c>cdv</c> with the full path to the - erlang crashdump as an argument. The script can be found in the - priv directory of the <c>observer</c> application. This starts the - Crashdump Viewer GUI and loads the given file. If no file name is - given, a file dialog will be opened where the file can be + <p>The easiest way to start Crashdump Viewer is to use + shell script <c>cdv</c> with the full path to the + Erlang crashdump as argument. The script is located in + directory <c>priv</c> of the Observer application. This starts the + Crashdump Viewer GUI and loads the specified file. If no filename is + specified, a file dialog is opened where the file can be selected.</p> - <p>Under Windows the batch file <c>cdv.bat</c> can be used.</p> + <p>Under Windows, the batch file <c>cdv.bat</c> can be used.</p> - <p>It is also possible to start the Crashdump Viewer from within - an erlang node by calling <seealso + <p>Crashdump Viewer can also be started from + an Erlang node by calling <seealso marker="crashdump_viewer#start/0">crashdump_viewer:start/0</seealso> or <seealso marker="crashdump_viewer#start/1">crashdump_viewer:start/1</seealso>.</p> </section> <section> - <title>The graphical interface</title> + <title>GUI</title> - <p>The main window is opened when Crashdump Viewer has loaded a - crashdump. It contains a title bar, a menu bar, a number of - information panels and a status bar.</p> + <p>The GUI main window is opened when Crashdump Viewer has loaded a + crashdump. It contains a title bar, a menu bar, + information tabs, and a status bar.</p> <p>The title bar shows the name of the currently loaded crashdump.</p> <p>The menu bar contains a <em>File</em> menu and a <em>Help</em> - menu. From the File menu a new crashdump can be loaded or the tool - can be terminated. From the Help menu this user's guide and the - chapter "How to interpret the Erlang crash dumps" from the user's - guide for Erlang runtime system can be opened. "How to interpret + menu. From the <em>File</em> menu, a new crashdump can be loaded or + the tool can be terminated. From the <em>Help</em> menu, this User's Guide + and section "How to interpret the Erlang crash dumps" from the + ERTS application can be opened. "How to interpret the Erlang crash dumps" describes the raw crashdumps in - detail. Here you will also find information about each single - field in the different information pages. This document can also - be found directly in the OTP online documentation, via the Erlang - runtime system user's guide.</p> + detail and includes information about each + field in the information pages."How to interpret the Erlang crash dumps" + is also available in the OTP online documentation.</p> - <p>The status bar at the bottom of the window will show a warning + <p>The status bar at the bottom of the window shows a warning if the currently loaded dump is truncated.</p> - <p>The centre area of the main window contains the information - panels. Each panel displays information about a specific item or a - list of items. A panel is selected by clicking the title of the - tab.</p> + <p>The center area of the main window contains the information + tabs. Each tab displays information about a specific item or a + list of items. Select a tab by clicking the tab title.</p> - <p>From panels that display lists of items, for example the - Processes- or the Ports panel, a new window with further - information can be opened by double clicking a row or by right - clicking the row and selecting an item from the drop down + <p>From tabs displaying lists of items, for example, the + <em>Processes</em> tab or the <em>Ports</em> tab, a new window with + more information can be opened by double-clicking a row or by right- + clicking the row and selecting an item from the drop-down menu. The new window is called a detail window. Detail windows can - be opened for processes, ports, nodes and modules.</p> + be opened for processes, ports, nodes, and modules.</p> - <p>The various information shown in a detail window might contain - links to processes or ports. Clicking one of these links will open + <p>The information shown in a detail window can contain + links to processes or ports. Clicking one of these links opens the detail window for the process or port in question. If the - process or port resided on a remote node, there will be no - information available. Clicking the link will then pop up a dialog - where you can choose whether to open the detail window for the - remote node or not. + process or port resides on a remote node, no + information is available. Clicking the link then displays a dialog + where you can choose to open the detail window for the + remote node. </p> - <p>Some of the panels contain a left hand menu where sub items of - the panel's information area can be selected. Click on one of the - rows, and the information will be displayed in the right hand + <p>Some tabs contain a left-hand menu where subitems of + the information area can be selected. Click one of the + rows, and the information is displayed in the right-hand information area.</p> </section> <section> - <title>Data content</title> - - <p>Each panel in the main window contains an information - page. If no information is found for an item, the page will be - empty. The reason for not finding any information about an item - can be that the dump is truncated, that it is a dump from an old - OTP release in which this item was not written or that the item - simply wasn't present in the system at the point of failure.</p> - - <p>If the dump was truncated, a warning is displayed in the - status bar of the main window.</p> - - <p>Even if some information about an item exists, there might be + <title>Tab Content</title> + + <p>Each tab in the main window contains an information + page. If no information is found for an item, the page is + empty. The reason for not finding information about an item + can be the following:</p> + <list type="bulleted"> + <item>It is a dump from an old OTP release in which this item was not written.</item> + <item>The item was not present in the system at the point of failure.</item> + <item>The dump is truncated. In this case, a warning is displayed in the + status bar of the main window.</item> + </list> + + <p></p> + + <p>Even if some information about an item exists, there can be empty fields if the dump originates from an old OTP release.</p> - <p>The value "-1" in any field means "unknown", and in most + <p>The value <c>-1</c> in any field means "unknown", and in most cases it means that the dump was truncated somewhere around this field.</p> - <p>The sections below describe some of the fields in the - different information panels. These are fields that do not exist + <p>The following sections describe some of the fields in the + information tabs. These are fields that do not exist in the raw crashdump, or in some way differ from the fields in - the raw crashdump. Details about other fields can be found in - the user's guide for the Erlang runtime system, in the chapter - "How to interpret the Erlang crash dumps". That chapter can also - be opened from the Help menu in the Crashdump Viewer's main - window, and there are also direct links from the specific - sections below to related information in "How to interpret the - Erlang crash dumps".</p> + the raw crashdump. For details about other fields, see + the + <seealso marker="erts:users_guide">ERTS User's Guide</seealso>, section + "How to interpret the Erlang crash dumps". That section can also + be opened from the <em>Help</em> menu in the main window. + There are also links from the following sections to related information + in "How to interpret the Erlang crash dumps".</p> </section> <section> <marker id="general_info"/> - <title>General information</title> + <title>General Tab</title> - <p>The <em>General information</em> panel shows a short overview + <p>Tab <em>General</em> shows a short overview of the dump.</p> - <p>The following fields are not described in the Erlang runtime - system user's guide:</p> + <p>The following fields are not described in the ERTS + User's Guide:</p> <taglist> - <tag><em>Crashdump created on</em></tag> - <item>Time of failure.</item> - - <tag><em>Memory allocated</em></tag> - <item>The total number of bytes allocated, equivalent to - <c>c:memory(total)</c>.</item> - - <tag><em>Memory maximum</em></tag> - <item>The maximum number of bytes that has been allocated during - the lifetime of the originating node. This will only be shown if - the Erlang runtime system was run instrumented.</item> - - <tag><em>Atoms</em></tag> - <item>If available in the dump, this is the total number of - atoms in the atom table. If the size of the atom table is not - available, the number of atoms visible in the dump is - presented.</item> - - <tag><em>Processes, ETS tables and Funs</em></tag> - <item>The number of processes, ETS tables and funs visible in - the dump.</item> + <tag><c>Crashdump created on</c></tag> + <item><p>Time of failure.</p></item> + + <tag><c>Memory allocated</c></tag> + <item><p>The total number of bytes allocated, equivalent to + <c>c:memory(total)</c>.</p></item> + + <tag><c>Memory maximum</c></tag> + <item><p>The maximum number of bytes that has been allocated during + the lifetime of the originating node. This is only shown if + the Erlang runtime system is run instrumented.</p></item> + + <tag><c>Atoms</c></tag> + <item><p>If available in the dump, this is the total number of + atoms in the atom table. If the size of the atom table is + unavailable, the number of atoms visible in the dump is + displayed.</p></item> + + <tag><c>Processes</c></tag> + <item><p>The number of processes visible in the dump.</p></item> + + <tag><c>ETS tables</c></tag> + <item><p>The number of ETS tables visible in the dump.</p></item> + + <tag><c>Funs</c></tag> + <item><p>The number of funs visible in the dump.</p></item> </taglist> - <p> - <seealso marker="erts:crash_dump#general_info">More...</seealso> + <p>For details, see + <seealso marker="erts:crash_dump#general_info">General Information</seealso> + in section "How to Interpret the Erlang Crash Dumps" in ERTS. </p> </section> <section> <marker id="processes"/> - <title>Processes</title> + <title>Processes Tab</title> - <p>The <em>Processes</em> panel shows a list of all processes - found in the crashdump, including some short information about - each process. By default the processes are sorted by their - pids. To sort by other topic, click the desired column - heading.</p> + <p>Tab <em>Processes</em> shows a list of all processes + found in the crashdump, including brief information about + each process. By default, the processes are sorted by their + pids. To sort by another topic, click the desired column heading.</p> - <p>The <em>Memory</em> column shows the 'Memory' field which was - added to crashdumps in R16B01. This is the total amount of memory + <p>Column <em>Memory</em> shows the 'Memory' field that was + added to crashdumps in Erlang/OTP R16B01. This is the total amount of memory used by the process. For crashdumps from earlier releases, this - column shows the 'Stack+heap' field. The value shown is always in - bytes.</p> + column shows the 'Stack+heap' field. The value is always in bytes.</p> - <p>To view detailed information about a specific process, double - click the row in the list or right click the row and select - "Properties for <pid>".</p> + <p>To view detailed information about a specific process, double- + click the row in the list, or right-click the row and select + <em>Properties for <pid></em>.</p> - <p> - <seealso marker="erts:crash_dump#processes">More...</seealso> + <p>For details, see + <seealso marker="erts:crash_dump#processes">Process Information</seealso> + in section "How to Interpret the Erlang Crash Dumps" in ERTS. </p> </section> <section> <marker id="ports"/> - <title>Ports</title> + <title>Ports Tab</title> - <p>The <em>Ports</em> panel is similar to the <em>Processes</em> - panel, except it lists all ports found in the crashdump.</p> + <p>Tab <em>Ports</em> is similar to the <em>Processes</em> + tab, except it lists all ports found in the crashdump.</p> - <p>To see more details about a specific port, dobule click the row - or right click it and select "Properties for <port>". From - the right click menu you can also select "Properties for - <pid>", where <pid> is the process connected to the + <p>To view more details about a specific port, double-click the row + or right-click it and select <em>Properties for <port></em>. From + the right-click menu, you can also select <em>Properties for + <pid></em>, where <c><pid></c> is the process connected to the port.</p> - <p> - <seealso marker="erts:crash_dump#ports"> - More...</seealso> + <p>For details, see + <seealso marker="erts:crash_dump#ports">Port Information</seealso> + in section "How to Interpret the Erlang Crash Dumps" in ERTS. </p> </section> <section> <marker id="ets_tables"/><marker id="internal_ets_tables"/> - <title>ETS tables</title> + <title>ETS Tables Tab</title> - <p>The <em>ETS Tables</em> panel shows all ETS table information - found in the dump. The 'Id' is the same as the 'Table' field found - in the raw crashdump, and 'Memory' is the 'Words' field from the - raw crashdump translated into bytes. For tree tables there will - be no value in the 'Objects' field.</p> + <p>Tab <em>ETS Tables</em> shows all ETS table information + found in the dump. <em>Id</em> is the same as the 'Table' field + in the raw crashdump. <em>Memory</em> is the 'Words' field from the + raw crashdump translated into bytes. For tree tables, there is + no value in the 'Objects' field.</p> - <p>To open the detailed information page about the table, double - click or right click the row and select "Properties for - 'Identifier'".</p> + <p>To open the detailed information page about the table, double- + click, or right-click the row and select <em>Properties for + 'Identifier'</em>.</p> <p>To open the detailed information page about the owner process - of an ETS table, right click the row and select "Properties for - <pid>".</p> + of an ETS table, right-click the row and select <em>Properties for + <pid></em>.</p> - <p> - <seealso marker="erts:crash_dump#ets_tables"> - More...</seealso> + <p>For details, see + <seealso marker="erts:crash_dump#ets_tables">ETS Tables</seealso> + in section "How to Interpret the Erlang Crash Dumps" in ERTS. </p> </section> <section> <marker id="timers"/> - <title>Timers</title> + <title>Timers Tab</title> - <p>The <em>Timers</em> panel shows all timer information found in + <p>Tab <em>Timers</em> shows all timer information found in the dump.</p> <p>To open the detailed information page about the owner process - of a timer, right click the row and select "Properties for - <pid>".</p> + of a timer, right-click the row and select <em>Properties for + <pid></em>.</p> - <p>Double clicking a row in the Timers panel has no effect.</p> + <p>Double-clicking a row in the <em>Timers</em> tab has no effect.</p> - <p> - <seealso marker="erts:crash_dump#timers">More...</seealso> + <p>For details, see + <seealso marker="erts:crash_dump#timers">Timers</seealso> + in section "How to Interpret the Erlang Crash Dumps" in ERTS. </p> </section> <section> <marker id="schedulers"/> - <title>Schedulers</title> + <title>Schedulers Tab</title> - <p>The <em>Schedulers</em> panel shows all scheduler information + <p>Tab <em>Schedulers</em> shows all scheduler information found in the dump.</p> <p>To open the detailed information page about the scheduler, - double click or right click the row and select "Properties for - 'Identifier'".</p> + double-click, or right-click the row and select <em>Properties for + 'Identifier'</em>.</p> - <p> - <seealso marker="erts:crash_dump">More...</seealso> + <p>For details, see + <seealso marker="erts:crash_dump#scheduler">Scheduler Information</seealso> + in section "How to Interpret the Erlang Crash Dumps" in ERTS. </p> </section> <section> <marker id="funs"/> - <title>Funs</title> + <title>Funs Tab</title> - <p>The <em>Funs</em> panel shows all Fun information found in the + <p>Tab <em>Funs</em> shows all fun information found in the dump.</p> <p>To open the detailed information page about the module to which - the fun belongs, right click the row and select "Properties for - <mod>".</p> + the fun belongs, right-click the row and select <em>Properties for + <mod></em>.</p> - <p>Double clicking a row in the Funs panel has no effect.</p> + <p>Double-clicking a row in the <em>Funs</em> tab has no effect.</p> - <p> - <seealso marker="erts:crash_dump#funs">More...</seealso> + <p>For details, see + <seealso marker="erts:crash_dump#funs">Fun Information</seealso> + in section "How to Interpret the Erlang Crash Dumps" in ERTS. </p> </section> <section> <marker id="atoms"/> - <title>Atoms</title> + <title>Atoms Tab</title> - <p>The <em>Atoms</em> panel lists all atoms found in the dump. By + <p>Tab <em>Atoms</em> lists all atoms found in the dump. By default the atoms are sorted in creation order from first to last. This is opposite of the raw crashdump where atoms are listed from last to first, meaning that if the dump was truncated in the - middle of the atom list only the last created atoms will be seen - in the <em>Atoms</em> panel.</p> + middle of the atom list, only the last created atoms are visible + in the <em>Atoms</em> tab.</p> - <p> - <seealso marker="erts:crash_dump#atoms">More...</seealso> + <p>For details, see + <seealso marker="erts:crash_dump#atoms">Atoms</seealso> + in section "How to Interpret the Erlang Crash Dumps" in ERTS. </p> </section> <section> <marker id="distribution_info"/> - <title>Nodes</title> + <title>Nodes Tab</title> - <p>The <em>Nodes</em> panel shows a list of all external erlang - nodes which are referenced from the crashdump.</p> + <p>Tab <em>Nodes</em> shows a list of all external Erlang + nodes that are referenced from the crashdump.</p> - <p>If the page is empty it either means that the crashed node was - not distributed, that it was distributed but had no references to - other nodes or that the dump was truncated.</p> + <p>If the page is empty, it means either of the following:</p> + <list type="bulleted"> + <item>The crashed node is not distributed.</item> + <item>The crashed node is distributed but has no references to other nodes.</item> + <item>The dump is truncated.</item> + </list> - <p>If the node was distributed, all referenced nodes are - shown. The column named <em>Connection type</em> shows if the node - is visible, hidden or not connected. Visible nodes are alive nodes + <p>If the node is distributed, all referenced nodes are + visible. Column <em>Connection type</em> shows if the node + is visible, hidden, or not connected. Visible nodes are alive nodes with a living connection to the originating node. Hidden nodes are - the same as visible nodes, except they are started with the - <c>-hidden</c> flag. Not connected nodes are nodes that are not + the same as visible nodes, except they are started with flag + <c>-hidden</c>. Not connected nodes are nodes that are not connected to the originating node anymore, but references - (i.e. process or port identifiers) exist.</p> + (that is, process or port identifiers) exist.</p> - <p>To see more detailed information about a node, double click the - row or right click the row and select "Properties for node - <node>". From the right click menu you can also select - "Properties for <port>", to open the detailed information + <p>To see more detailed information about a node, double-click the + row, or right-click the row and select <em>Properties for node + <node></em>. From the right-click menu, you can also select + <em>Properties for <port></em>, to open the detailed information window for the controlling port.</p> - <p>In the detailed information window for a node, any exsisting + <p>In the detailed information window for a node, any existing links and monitors between processes on the originating node and - the connected node are shown. <em>Extra Info</em> may contain - debug information (i.e. special information written if the - emulator is debug compiled) or error information.</p> + the connected node are displayed. <em>Extra Info</em> can contain + debug information (that is, special information written if the + emulator is debug-compiled) or error information.</p> - <p> - <seealso marker="erts:crash_dump#distribution_info"> - More...</seealso> + <p>For details, see + <seealso marker="erts:crash_dump#distribution_info">Distribution Information</seealso> + in section "How to Interpret the Erlang Crash Dumps" in ERTS. </p> </section> <section> <marker id="loaded_modules"/> - <title>Loaded modules</title> + <title>Modules Tab</title> - <p>The <em>Modules</em> panel lists all modules that were loaded - on the originating node, and the current size of the code. If old - code exsits, the old size is also shown.</p> + <p>Tab <em>Modules</em> lists all modules loaded + on the originating node, and the current code size. If old + code exists, the old size is also shown.</p> - <p>To see detailed information about a specific module, double - click the row or right click it and select "Properties for - <mod>".</p> + <p>To view detailed information about a specific module, double- + click the row, or right-click it and select <em>Properties for + <mod></em>.</p> - <p> - <seealso marker="erts:crash_dump#loaded_modules"> - More...</seealso> + <p>For details, see + <seealso marker="erts:crash_dump#loaded_modules">Loaded Module Information</seealso> + in section "How to Interpret the Erlang Crash Dumps" in ERTS. </p> </section> <section> <marker id="memory"/> - <title>Memory</title> - - <p>The <em>Memory</em> panel shows memory and allocator - information. From the left hand menu you can select:</p> + <title>Memory Tab</title> - <list> + <p>Tab <em>Memory</em> shows memory and allocator + information. From the left-hand menu you can select the following:</p> - <item><em>Memory</em> <seealso - marker="erts:crash_dump#memory">More...</seealso></item> + <taglist> + <tag><em>Memory</em></tag> + <item><p>See + <seealso marker="erts:crash_dump#memory">Memory Information</seealso> + in section "How to Interpret the Erlang Crash Dumps" in ERTS.</p></item> - <item><em>Allocator Summary</em> - this page presents a - summary of values from all allocators below.</item> + <tag><em>Allocator Summary</em></tag> + <item><p>This page presents a summary of values from all allocators underneath it.</p></item> - <item><em><Allocator></em> - one entry per allocator - <seealso - marker="erts:crash_dump#allocator">More...</seealso></item> + <tag><em><Allocator></em></tag> + <item><p>One entry per allocator. See + <seealso marker="erts:crash_dump#allocator">Allocator</seealso> + in section "How to Interpret the Erlang Crash Dumps" in ERTS.</p></item> - <item><em>Allocated Areas</em> <seealso - marker="erts:crash_dump#allocated_areas">More...</seealso></item> + <tag><em>Allocated Areas</em></tag> + <item><p>See + <seealso marker="erts:crash_dump#allocated_areas">Allocated Areas</seealso> + in section "How to Interpret the Erlang Crash Dumps" in ERTS.</p></item> - </list> + </taglist> </section> <section> <marker id="internal_tables"/> - <title>Internal tables</title> + <title>Internal Tables Tab</title> - <p>On the <em>Internal Tables</em> panel you can choose from the - left hand menu to see hash tables or index tables.</p> + <p>On tab <em>Internal Tables</em> you can from the + left-hand menu select <em>Hash Tables</em>, <em>Index Tables</em>, + or <em>Internal ETS Tables</em>.</p> - <p> - <seealso marker="erts:crash_dump#internal_tables">More...</seealso> + <p>For details, see + <seealso marker="erts:crash_dump#internal_tables">Internal Table Information</seealso> + in section "How to Interpret the Erlang Crash Dumps" in ERTS. </p> </section> </chapter> diff --git a/lib/observer/doc/src/etop.xml b/lib/observer/doc/src/etop.xml index c1e336177f..52f3b2a156 100644 --- a/lib/observer/doc/src/etop.xml +++ b/lib/observer/doc/src/etop.xml @@ -25,7 +25,7 @@ </legalnotice> <title>etop</title> - <prepared>Siri hansen</prepared> + <prepared>Siri Hansen</prepared> <responsible></responsible> <docno></docno> <approved></approved> @@ -35,89 +35,79 @@ <file></file> </header> <module>etop</module> - <modulesummary>Erlang Top is a tool for presenting information about erlang processes similar to the information presented by "top" in UNIX.</modulesummary> + <modulesummary>Erlang Top is a tool for presenting information about Erlang + processes similar to the information presented by "top" in UNIX.</modulesummary> <description> - <p><c>etop</c> should be started with the provided scripts - <c>etop</c>. This will start a hidden erlang node - which connects to the node to be measured. The measured node is - given with the <c>-node</c> option. If the measured node has a + <p>Start Erlang Top with the provided scripts + <c>etop</c>. This starts a hidden Erlang node + that connects to the node to be measured. The measured node is + specified with option <c>-node</c>. If the measured node has a different cookie than the default cookie for the user who - invokes the script, the cookie must be explicitly given witht - the <c>-setcookie</c> option.</p> + invokes the script, the cookie must be explicitly specified with + option <c>-setcookie</c>.</p> - <p>Under Windows the batch file <c>etop.bat</c> can be used.</p> + <p>Under Windows, batch file <c>etop.bat</c> can be used.</p> - <p>The following configuration parameters exist for the - <c>etop</c> tool. When executing the <c>etop</c> script, - these parameters can be given as command line options, - e.g. <c>etop -node testnode@myhost -setcookie MyCookie</c>.</p> + <p>When executing the <c>etop</c> script, configuration + parameters can be specified as command-line options, + for example, <c>etop -node testnode@myhost -setcookie MyCookie</c>. + The following configuration parameters exist for the + tool:</p> <taglist> - <tag>node</tag> - <item>The measured node. - <br></br> -Value: atom() - <br></br> -Mandatory</item> - <tag>setcookie</tag> - <item>Cookie to use for the etop node - must be the same - as the cookie on the measured node. - <br></br> -Value: atom()</item> - <tag>lines</tag> - <item>Number of lines (processes) to display. - <br></br> -Value: integer() - <br></br> -Default: 10</item> - <tag>interval</tag> - <item>The time interval (in seconds) between each update of - the display. - <br></br> -Value: integer() - <br></br> -Default: 5</item> - <tag>accumulate</tag> - <item>If <c>true</c> the execution time and reductions are - accumulated. - <br></br> -Value: boolean() - <br></br> -Default: <c>false</c></item> - <tag>sort</tag> - <item>Identifies what information to sort by. - <br></br> -Value: <c>runtime | reductions | memory | msg_q</c> <br></br> -Default: <c>runtime</c> (<c>reductions</c> if - <c>tracing=off</c>)</item> - <tag>tracing</tag> - <item><c>etop</c> uses the erlang trace facility, and thus no + <tag><c>node</c></tag> + <item><p>The measured node.</p> + <p>Value: <c>atom()</c></p> + <p>Mandatory</p></item> + <tag><c>setcookie</c></tag> + <item><p>Cookie to use for the <c>etop</c> node. Must be same as the + cookie on the measured node.</p> + <p>Value: <c>atom()</c></p></item> + <tag><c>lines</c></tag> + <item><p>Number of lines (processes) to display.</p> + <p>Value: <c>integer()</c></p> + <p>Default: <c>10</c></p></item> + <tag><c>interval</c></tag> + <item><p>Time interval (in seconds) between each update of + the display.</p> + <p>Value: <c>integer()</c></p> + <p>Default: <c>5</c></p></item> + <tag><c>accumulate</c></tag> + <item><p>If <c>true</c>, the execution time and reductions are + accumulated.</p> + <p>Value: <c>boolean()</c></p> + <p>Default: <c>false</c></p></item> + <tag><c>sort</c></tag> + <item><p>Identifies what information to sort by.</p> + <p>Value: <c>runtime | reductions | memory | msg_q</c></p> + <p>Default: <c>runtime</c> (<c>reductions</c> if <c>tracing=off</c>)</p></item> + <tag><c>tracing</c></tag> + <item><p><c>etop</c> uses the Erlang trace facility, and thus no other tracing is possible on the measured node while <c>etop</c> is running, unless this option is set to <c>off</c>. Also helpful if the <c>etop</c> tracing causes too high load on the measured node. With tracing off, runtime is - not measured. - <br></br> -Value: <c>on | off</c> <br></br> -Default: <c>on</c></item> + not measured.</p> + <p>Value: <c>on | off</c></p> + <p>Default: <c>on</c></p></item> </taglist> - <p>See the <seealso marker="etop_ug">user's guide</seealso> for - more information about the <c>etop</c> tool.</p> + <p>For detalis about Erlang Top, see the + <seealso marker="etop_ug">User's Guide</seealso>.</p> </description> <funcs> <func> <name>start() -> ok</name> - <fsummary>Start etop</fsummary> + <fsummary>Start etop.</fsummary> <desc> - <p>This function starts <c>etop</c>. - Note that etop is preferably started with the etop script.</p> + <p>Starts <c>etop</c>. + Notice that <c>etop</c> is preferably started with the <c>etop</c> script.</p> </desc> </func> <func> <name>start(Options) -> ok</name> - <fsummary>Start etop</fsummary> + <fsummary>Start etop.</fsummary> <type> <v>Options = [Option]</v> <v>Option = {Key, Value}</v> @@ -125,31 +115,30 @@ Default: <c>on</c></item> <v>Value = term()</v> </type> <desc> - <p>This function starts <c>etop</c>. Use - <seealso marker="#help/0">help/0</seealso> to see a - description of the possible options.</p> + <p>Starts <c>etop</c>. To view the possible options, use + <seealso marker="#help/0"><c>help/0</c></seealso>.</p> </desc> </func> <func> <name>help() -> ok</name> - <fsummary>Print etop's help</fsummary> + <fsummary>Display the etop help.</fsummary> <desc> - <p>This function prints the help of <c>etop</c> and + <p>Displays the help of <c>etop</c> and its options.</p> </desc> </func> <func> <name>config(Key,Value) -> Result</name> - <fsummary>Change tool's configuration</fsummary> + <fsummary>Change the configuration of the tool.</fsummary> <type> <v>Result = ok | {error,Reason}</v> <v>Key = lines | interval | accumulate | sort</v> <v>Value = term()</v> </type> <desc> - <p>This function is used to change the tool's configuration - parameters during runtime. The table above indicates the - allowed values for each parameter.</p> + <p>Changes the configuration parameters of the tool during runtime. + Allowed parameters are <c>lines</c>, <c>interval</c>, <c>accumulate</c>, + and <c>sort</c>.</p> </desc> </func> <func> @@ -160,14 +149,14 @@ Default: <c>on</c></item> <v>File = string()</v> </type> <desc> - <p>This function dumps the current display to a text file.</p> + <p>Dumps the current display to a text file.</p> </desc> </func> <func> <name>stop() -> stop</name> - <fsummary>Terminate etop</fsummary> + <fsummary>Terminate etop.</fsummary> <desc> - <p>This function terminates <c>etop</c>.</p> + <p>Terminates <c>etop</c>.</p> </desc> </func> </funcs> diff --git a/lib/observer/doc/src/etop_ug.xml b/lib/observer/doc/src/etop_ug.xml index 7059f689d3..d663b089c2 100644 --- a/lib/observer/doc/src/etop_ug.xml +++ b/lib/observer/doc/src/etop_ug.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2002</year><year>2013</year> + <year>2002</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -32,15 +32,25 @@ <section> <title>Introduction</title> - <p>Erlang Top, <c>etop</c> is a tool for presenting information - about erlang processes similar to the information presented by + <p>Erlang Top, <c>etop</c>, is a tool for presenting information + about Erlang processes similar to the information presented by <c>top</c> in UNIX. </p> </section> + <section> + <title>Getting Started</title> + <p>Start Erlang Top in either of the following ways:</p> + <list type="bulleted"> + <item>Use script <c>etop</c>.</item> + <item>Use batch file <c>etop.bat</c>, for example, + <c>etop -node tiger@durin</c>.</item> + </list> + </section> + <section> <title>Output</title> - <p>The output from <c>etop</c> looks like this:</p> + <p>The output from Erlang Top is as follows:</p> <code type="none"><![CDATA[ ======================================================================================== tiger@durin 13:40:32 @@ -65,59 +75,60 @@ Pid Name or Initial Func Time Reds Memory MsgQ Current Func <p>The header includes some system information: </p> <taglist> - <tag>Load</tag> - <item><c>cpu</c> is <c>Runtime/Wallclock</c>, i.e. the - percentage of time where the node has been - active, <c>procs</c> is the number of processes on the node, - and <c>runq</c> is the number of processes that are ready to - run.</item> - <tag>Memory</tag> - <item>This is the memory allocated by the node in kilo bytes.</item> + <tag><c>Load</c></tag> + <item> + <taglist> + <tag><c>cpu</c></tag> + <item><p><c>Runtime/Wallclock</c>, that is, the percentage of time + where the node has been active.</p></item> + <tag><c>procs</c></tag> + <item><p>The number of processes on the node.</p></item> + <tag><c>runq</c></tag> + <item><p>The number of processes that are ready to run.</p></item> + </taglist> + </item> + <tag><c>Memory</c></tag> + <item><p>The memory allocated by the node in kilobytes.</p></item> </taglist> <p>For each process the following information is presented: </p> <taglist> - <tag>Time</tag> - <item>This is the runtime for the process, i.e. the actual - time the process has been scheduled in.</item> - <tag>Reds</tag> - <item>This is the number of reductions that has been executed - on the process</item> - <tag>Memory</tag> - <item>This is the size of the process in bytes, obtained by a - call to <c>process_info(Pid,memory)</c>.</item> - <tag>MsgQ</tag> - <item>This is the length of the message queue for the process.</item> + <tag><c>Time</c></tag> + <item><p>The runtime for the process, that is, the time that the process + has been scheduled in.</p></item> + <tag><c>Reds</c></tag> + <item><p>The number of reductions executed on the process.</p></item> + <tag><c>Memory</c></tag> + <item><p>The size of the process in bytes, obtained by a + call to <c>process_info(Pid,memory)</c>.</p></item> + <tag><c>MsgQ</c></tag> + <item><p>The length of the message queue for the process.</p></item> </taglist> <note> <p><em>Time</em> and <em>Reds</em> can be presented as - accumulated values or as values since last update.</p> + accumulated values or as values since the last update.</p> </note> </section> - <section> - <title>Start</title> - <p>To start etop use the script - <c>etop</c> or the batch file <c>etop.bat</c>, e.g. <c>etop -node tiger@durin</c>, - </p> - </section> - - <section> + <section> <title>Configuration</title> <p>All configuration parameters can be set at start by adding - <c>-OptName Value</c> to the command line, e.g. <c>etop -node tiger@durin -setcookie mycookie -lines 15</c>. - </p> - <p>The parameters <c>lines</c>, <c>interval</c>, <c>accumulate</c> - and <c>sort</c> can be changed during runtime by the - function <c>etop:config/2</c>. - </p> - <p>A list of all valid configuration parameters can be found in - the reference manual for <c>etop</c>. + <c>-OptName Value</c> to the command line, for example:</p> + <pre> +% <input>etop -node tiger@durin -setcookie mycookie -lines 15</input></pre> + + <p>A list of all valid Erlang Top configuration parameters is available in + module <seealso marker="etop"><c>etop</c></seealso>. </p> - <section> - <title>Example: Change configuration with text based presentation</title> - <code type="none"><![CDATA[ + <p>The parameters <c>lines</c>, <c>interval</c>, <c>accumulate</c>, + and <c>sort</c> can be changed during runtime with function + <seealso marker="etop#config/2"><c>etop:config/2</c></seealso>. + </p> + <p><em>Example:</em></p> + <p>Change configuration parameter <c>lines</c> with text-based presentation. + Before the change, 10 lines are presented as follows:</p> + <code type="none"><![CDATA[ ======================================================================================== tiger@durin 10:12:39 Load: cpu 0 Memory: total 1858 binary 33 @@ -137,8 +148,14 @@ Pid Name or Initial Func Time Reds Memory MsgQ Current Func <127.43.0> ddll_server 0 582 3744 0 gen_server:loop/6 <127.5.0> application_controll 0 569 6756 0 gen_server:loop/6 ======================================================================================== ]]></code> - <p><em><c>etop:config(lines,5).</c></em> <br></br> -<em><c>ok</c></em></p> + <p>Function <c>etop:config/2</c> is called to change the number of showed + lines to 5:</p> + + <pre> +> <input>etop:config(lines,5).</input> +ok</pre> + + <p>After the change, 5 lines are presented as follows:</p> <code type="none"><![CDATA[ (etop@durin)2> ======================================================================================== @@ -156,19 +173,20 @@ Pid Name or Initial Func Time Reds Memory MsgQ Current Func <127.43.0> ddll_server 0 0 3744 0 gen_server:loop/6 ======================================================================================== ]]></code> - </section> </section> <section> - <title>Print to file</title> - <p>At any time, the current <c>etop</c> display can be dumped to a - text file with the function <c>etop:dump/1</c>. + <title>Print to File</title> + <p>At any time, the current Erlang Top display can be dumped to a + text file with function + <seealso marker="etop#dump/1"><c>etop:dump/1</c></seealso>. </p> </section> <section> <title>Stop</title> - <p>Use the function <c>etop:stop/0</c> to stop <c>etop</c>. + <p>To stop Erlang Top, use function + <seealso marker="etop#stop/0"><c>etop:stop/0</c></seealso>. </p> </section> </chapter> diff --git a/lib/ose/doc/src/ose_app.xml b/lib/observer/doc/src/introduction_ug.xml index d555f0ec4f..21f0dc709f 100644 --- a/lib/ose/doc/src/ose_app.xml +++ b/lib/observer/doc/src/introduction_ug.xml @@ -1,10 +1,10 @@ <?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE appref SYSTEM "appref.dtd"> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> -<appref> +<chapter> <header> <copyright> - <year>2014</year><year>2014</year> + <year>2016</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -22,17 +22,28 @@ </legalnotice> - <title>Enea OSE</title> + <title>Introduction</title> <prepared></prepared> <docno></docno> <date></date> <rev></rev> + <file>introduction_ug.xml</file> </header> - <app>ose</app> - <appsummary>The OSE Application</appsummary> - <description> - <p>The OSE application contains modules and documentation that only - applies when running Erlang/OTP on Enea OSE.</p> - </description> +<section> + <title>Scope</title> + <p>The Observer application is a container including the following + tools for tracing and investigation of distributed systems:</p> + <list type="bulleted"> + <item>Observer</item> + <item>Trace Tool Builder</item> + <item>Erlang Top</item> + <item>Crashdump Viewer</item> + </list> + </section> -</appref> + <section> + <title>Prerequisites</title> + <p>It is assumed that the reader is familiar with the Erlang + programming language.</p> + </section> +</chapter> diff --git a/lib/observer/doc/src/observer.xml b/lib/observer/doc/src/observer.xml index bba5b1e33c..4d43ffe39f 100644 --- a/lib/observer/doc/src/observer.xml +++ b/lib/observer/doc/src/observer.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2011</year><year>2013</year> + <year>2011</year><year>2016</year> <holder>Ericsson AB, All Rights Reserved</holder> </copyright> <legalnotice> @@ -34,24 +34,25 @@ <file>observer.xml</file> </header> <module>observer</module> - <modulesummary>A GUI tool for observing an erlang system.</modulesummary> + <modulesummary>A GUI tool for observing an Erlang system.</modulesummary> <description> - <p>The observer is gui frontend containing various tools to - inspect a system. It displays system information, application - structures, process information, ets or mnesia tables and a frontend - for tracing with <seealso marker="ttb">ttb</seealso>. + <p>Observer is a graphical tool for observing the characteristics of + Erlang systems. The tool Observer displays system information, application + supervisor trees, process information, ETS tables, Mnesia tables, + and contains a front end for Erlang tracing with module + <seealso marker="ttb"><c>ttb</c></seealso>. </p> - <p>See the <seealso marker="observer_ug">user's guide</seealso> - for more information about how to get started.</p> + <p>For detalis about how to get started, see the + <seealso marker="observer_ug"><c>User's Guide</c></seealso>.</p> </description> <funcs> <func> <name>start() -> ok</name> - <fsummary>Start the observer gui</fsummary> + <fsummary>Start the Observer GUI.</fsummary> <desc> - <p>This function starts the <c>observer</c> gui. - Close the window to stop the application. + <p>Starts the Observer GUI. + To stop the tool, close the window. </p> </desc> </func> diff --git a/lib/observer/doc/src/observer_app.xml b/lib/observer/doc/src/observer_app.xml index 543216cee9..a52d6cb4d9 100644 --- a/lib/observer/doc/src/observer_app.xml +++ b/lib/observer/doc/src/observer_app.xml @@ -4,8 +4,7 @@ <appref> <header> <copyright> - <year>2002</year> - <year>2013</year> + <year>2002</year><year>2016</year> <holder>Ericsson AB, All Rights Reserved</holder> </copyright> <legalnotice> @@ -24,7 +23,7 @@ The Initial Developer of the Original Code is Ericsson AB. </legalnotice> - <title>observer</title> + <title>Observer</title> <prepared>Siri Hansen</prepared> <responsible>Siri Hansen</responsible> <docno></docno> @@ -32,26 +31,21 @@ <checked></checked> <date>2002-04-08</date> <rev>PA1</rev> - <file>observer_app.sgml</file> + <file>observer_app.xml</file> </header> - <app>observer</app> + <app>Observer</app> <appsummary>The Observer Application</appsummary> <description> - <p>This chapter describes the <em>OBSERVER</em> application in - OTP, which provides tools for tracing and investigation of - distributed systems.</p> + <p>The Observer application contains tools for tracing and + investigation of distributed systems.</p> </description> <section> <title>Configuration</title> - <p>There are currently no configuration parameters available for + <p>No configuration parameters are available for this application. </p> </section> - <section> - <title>SEE ALSO</title> - <p></p> - </section> </appref> diff --git a/lib/observer/doc/src/observer_ug.xml b/lib/observer/doc/src/observer_ug.xml index ff30d70913..ca354df864 100644 --- a/lib/observer/doc/src/observer_ug.xml +++ b/lib/observer/doc/src/observer_ug.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2011</year><year>2014</year> + <year>2011</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -32,179 +32,253 @@ <section> <title>Introduction</title> - <p>Observer, is a graphical tool for observing the characteristics of - erlang systems. Observer displays system information, application - supervisor trees, process information, ets or mnesia tables and contains - a frontend for erlang tracing. + <p>Observer is a graphical tool for observing the characteristics of + Erlang systems. Observer displays system information, application + supervisor trees, process information, ETS tables, Mnesia tables + and contains a front end for Erlang tracing. </p> </section> <section> - <title>General</title> - <p>Normally observer should be run from a standalone node to minimize - the impact of the system being observed. Example: + <title>Getting Started</title> + <p>Run Observer from a standalone node to minimize the impact of the + system being observed. </p> - <code> - > erl -sname observer -hidden -setcookie MyCookie -run observer - </code> + <p><em>Example:</em></p> + <pre> +% <input>erl -sname observer -hidden -setcookie MyCookie -run observer</input></pre> <p> - Choose which node to observe via <c>Nodes</c> menu. The <c>View/Refresh - Interval</c> controls how frequent the view should be updated. + Select the node to observe with menu <em>Nodes</em>. + Menu <em>View > Refresh interval</em> controls how often + the view is to be updated. The refresh interval is set per viewer so you can have different settings for each viewer. To minimize the system - impact only the active viewer is updated and the other - views will be updated when activated. + impact, only the active viewer is updated. Other views are updated + when activated. </p> - <p> In general the mouse buttons behaves as expected, use left click - to select objects, right click to pop up a menu with most used - choices and double click to bring up information about the - selected object. In most viewers with several columns you can change - sort order by left clicking on column header. + <p>The mouse buttons behave as expected. Use left-click + to select objects, right-click to get a menu with the most used + options, and double-click to display information about the + selected object. In most viewers with many columns, you can change + the sort order by left-clicking the column header. </p> </section> <section> - <title>Applications</title> - <p>The <c>Applications</c> view lists application information. + <title>System Tab</title> + <p>Tab <em>System</em> displays general information about the active Erlang node + and its runtime system, such as build configuration, system capabilities, and + overall use statistics. +</p> + </section> + + <section> + <title>Load Charts Tab</title> + <p>Tab <em>Load Charts</em> displays graphs of the current resource use on + the active Erlang node.</p> + <p>Graph <c>Scheduler Utilization</c> shows scheduler use per scheduler, + where each scheduler use has a unique color.</p> + <p>Graph <c>Memory Usage</c> shows the total memory use and per memory category + use, where each category has a unique color. The categories are as + follows:</p> + <taglist> + <tag><c>Total</c></tag> + <item><p>The sum of all memory categories.</p></item> + <tag><c>Processes</c></tag> + <item><p>The sum of all process memory used.</p></item> + <tag><c>Atom</c></tag> + <item><p>The size used by the atom table.</p></item> + <tag><c>Binary</c></tag> + <item><p>The sum of all off-heap binaries allocated.</p></item> + <tag><c>Code</c></tag> + <item><p>The memory allocated for code storage.</p></item> + <tag><c>Ets</c></tag> + <item><p>The used memory for all ETS tables.</p></item> + </taglist> + + <p>Graph <c>IO Usage</c> shows the current I/O load on the system.</p> + </section> + + <section> + <title>Memory Allocators Tab</title> + <p>Tab <em>Memory Allocators</em> displays detailed information of the carrier + size and current memory carriers. For details about memory carriers, + see module + <seealso marker="erts:erts_alloc"><c>erts_alloc</c></seealso> + in application ERTS.</p> + </section> + + <section> + <title>Applications Tab</title> + <p>Tab <em>Applications</em> presents application information. Select an application in the left list to display its supervisor - tree. - </p> - <p><c>Trace process</c> will add the selected process identifier - to <c>Trace Overview</c> view and the node the process resides on - will be added as well. - </p> - <p><c>Trace named process</c> will add the - registered name of the process. This can be useful when tracing on - several nodes, then processes with that name will be traced on all traced - nodes. - </p> - <p><c>Trace process tree</c> and <c>Trace named process - tree</c> will add the selected process and all processes below, - right of, it to the <c>Trace Overview</c> view. + tree. The right-click options in the tree are as follows: </p> + <taglist> + <tag>Process info</tag> + <item><p>Opens a detailed information window on the selected process, + including the following:</p> + <taglist> + <tag>Process Information</tag> + <item><p>Shows the process information.</p></item> + <tag>Messages</tag> + <item><p>Shows the process messages.</p></item> + <tag>Dictionary</tag> + <item><p>Shows the process dictionary.</p></item> + <tag>Stack Trace</tag> + <item><p>Shows the process current stack trace.</p></item> + <tag>State</tag> + <item><p>Shows the process state.</p></item> + <tag>Log</tag> + <item><p>If enabled and available, shows the process SASL + log entries.</p></item> + </taglist> + </item> + <tag>Trace process</tag> + <item><p>Adds the selected process identifier to tab <em>Trace Overview</em> + plus the node that the process resides on.</p></item> + <tag>Trace named process</tag> + <item><p>Adds the registered name of the process. This can be useful when tracing on + many nodes, as processes with that name are then traced on all traced nodes.</p></item> + <tag>Trace process tree</tag> + <item><p>Adds the selected process and all processes below, + right of it, to tab <em>Trace Overview</em>.</p></item> + <tag>Trace named process tree</tag> + <item><p>Adds the selected process and all processes below, + right of it, to tab <em>Trace Overview</em>.</p></item> + </taglist> </section> <section> - <title>Processes</title> - <p>The <c>Processes</c> view lists process information. - For each process the following information is presented: + <title>Processes Tab</title> + <p>Tab <em>Processes</em> lists process information in columns. + For each process the following information is displayed: </p> <taglist> <tag>Pid</tag> - <item>The process identifier.</item> + <item><p>The process identifier.</p></item> <tag>Reds</tag> - <item>This is the number of reductions that has been executed - on the process</item> + <item><p>The number of reductions executed on the process. + This can be presented as accumulated values or as values since the last update.</p></item> <tag>Memory</tag> - <item>This is the size of the process in bytes, obtained by a - call to <c>process_info(Pid,memory)</c>.</item> + <item><p>The size of the process, in bytes, obtained by a + call to <c>process_info(Pid,memory)</c>.</p></item> <tag>MsgQ</tag> - <item>This is the length of the message queue for the process.</item> + <item><p>The length of the message queue for the process.</p></item> </taglist> - <note> - <p><em>Reds</em> can be presented as accumulated values or as values since last update.</p> - </note> - <p><c>Process info</c> open a detailed information window on the selected process.</p> + + <p>Option <em>Process info</em> opens a detailed information window on the selected process, + including the following:</p> <taglist> <tag>Process Information</tag> - <item>Shows the process information.</item> + <item><p>Shows the process information.</p></item> <tag>Messages</tag> - <item>Shows the process messages.</item> + <item><p>Shows the process messages.</p></item> <tag>Dictionary</tag> - <item>Shows the process dictionary.</item> + <item><p>Shows the process dictionary.</p></item> <tag>Stack Trace</tag> - <item>Shows the process current stack trace.</item> + <item><p>Shows the process current stack trace.</p></item> <tag>State</tag> - <item>Show the process state.</item> + <item><p>Shows the process state.</p></item> <tag>Log</tag> - <item>If enabled and available, show the process SASL log entries.</item> + <item><p>If enabled and available, shows the process SASL log entries.</p></item> </taglist> + <note> - <p><c>Log</c> needs SASL application to be started on the observed node, with log_mf_h as log handler. - The Observed node must be R16B02 or higher. - <c>rb</c> server must not be started on the observed node when clicking on menu 'Log/Toggle log view'. - <c>rb</c> server will be stopped on the observed node when exiting or changing observed node. + <p><em>Log</em> requires application SASL to be started on the observed node, + with <c>log_mf_h</c> as log handler. + The Observed node must be Erlang/OTP R16B02 or higher. + The <c>rb</c> server must not be started on the observed node when clicking menu + <em>Log > Toggle log view</em>. The <c>rb</c> server is stopped on the observed node + when exiting or changing the observed node. </p> </note> - <p><c>Trace Processes</c> will add the selected process identifiers to the <c>Trace Overview</c> view and the - node the processes reside on will be added as well. - <c>Trace Named Processes</c> will add the registered name of processes. This can be useful - when tracing is done on several nodes, then processes with that name will be traced on all traced nodes. + + <p>Option <em>Trace Processes</em> adds the selected process identifiers to tab + <em>Trace Overview</em> plus the node that the processes reside on. </p> + <p>Option <em>Trace Named Processes</em> adds the registered name of the processes. This can be + useful when tracing is done on many nodes, as processes with that name are then traced on + all traced nodes.</p> + </section> <section> - <title>Table Viewer</title> - <p>The <c>Table Viewer</c> view lists tables. By default ets tables - are visible and unreadable, private ets, tables and tables created by the OTP - applications are not visible. Use <c>View</c> menu to view "system" - ets tables, unreadable ets tables or mnesia tables. + <title>Table Viewer Tab</title> + <p>Tab <em>Table Viewer</em> lists tables. By default, ETS tables + are displayed whereas unreadable private ETS tables and tables created by OTP + applications are not diplayed. Use menu <em>View</em> to view "system" + ETS tables, unreadable ETS tables, or Mnesia tables. </p> - <p>Double click to view the content of the table. Select table and activate <c>View/Table Information</c> - menu to view table information. - </p> - <p>In the table viewer you can regexp search for objects, edit and delete objects. + <p>Double-click to view the table content. To view table information, select the table + and activate menu <em>View > Table information</em>.</p> + <p>You can use <seealso marker="stdlib:re">regular + expressions</seealso> and search for objects, and edit or delete them. </p> </section> <section> - <title>Trace Overview</title> - <p>The <c>Trace Overview</c> view handles tracing. Tracing is done - by selecting which processes to be traced and how to trace - them. You can trace messages, function calls and events, where - events are process related events such as <c>spawn</c>, - <c>exit</c> and several others. - </p> - - <p>When you want to trace function calls, you also need to setup - <c>trace patterns</c>. Trace patterns selects the function calls - that will be traced. The number of traced function calls can be - further reduced with <c>match specifications</c>. Match - specifications can also be used to trigger additional information + <title>Trace Overview Tab</title> + <p>Tab <em>Trace Overview</em> handles tracing. Trace + by selecting the processes to be traced and how to trace + them. You can trace messages, function calls, and events, where + events are process-related events such as <c>spawn</c>, + <c>exit</c>, and many others. + </p> + + <p>To trace function calls, you also need to set up + <em>trace patterns</em>. Trace patterns select the function calls + to be traced. The number of traced function calls can be + further reduced with <em>match specifications</em>. Match + specifications can also be used to trigger more information in the trace messages. </p> - <note><p>Trace patterns only applies to the traced processes.</p></note> + <note><p>Trace patterns only apply to the traced processes.</p></note> <p> - Processes are added from the <c>Applications</c> or <c>Processes</c> views. - A special <c>new</c> identifier, meaning all processes spawned after trace start, - can be added with the <c>Add 'new' Process</c> button. + Processes are added from the <em>Applications</em> or <em>Processes</em> tabs. + A special <em>new</em> identifier, meaning all processes spawned after trace + start, can be added with button <em>Add 'new' Process</em>. </p> <p> - When adding processes, a window with trace options will pop up. The chosen options will - be set for the selected processes. - Process options can be changed by right clicking on a process. + When adding processes, a window with trace options is displayed. The chosen + options are set for the selected processes. + Process options can be changed by right-clicking a process. </p> <p> - Processes added by process identifiers will add the nodes these - processes resides on in the node list. Additional nodes can be added by the <c>Add - Nodes</c> button. + Processes added by process identifiers add the nodes these + processes reside on in the node list. More nodes can be added by clicking + button <em>Add Nodes</em>. </p> <p> - If function calls are traced, trace patterns must be added by <c>Add Trace Pattern</c> button. - Select a module, function(s) and a match specification. - If no functions are selected, all functions in the module will be traced. + If function calls are traced, trace patterns must be added by clicking button + <em>Add Trace Pattern</em>. Select a module, function(s), and a match specification. + If no functions are selected, all functions in the module are traced. A few basic match specifications are provided in the tool, and you can provide your own match specifications. The syntax of match - specifications are described in the <seealso - marker="erts:match_spec">ERTS User's Guide</seealso>. To simplify - the writing of a match specification they can also be written as - <c>fun/1</c> see <seealso marker="stdlib:ms_transform">ms_transform manual page</seealso> for - further information. - </p> - - <p>Use the <c>Start trace</c> button to start the trace. - By default trace output is written to a new window, tracing is stopped when the - window is closed, or with <c>Stop Trace</c> button. - Trace output can be changed via <c>Options/Output</c> menu. - The trace settings, including match specifications, can be saved to, or loaded from, a file. - </p> - <p>More information about tracing can be found in <seealso - marker="runtime_tools:dbg">dbg</seealso> and in the chapter "Match - specifications in Erlang" in <seealso marker="erts:match_spec">ERTS User's - Guide</seealso> and the - <seealso marker="stdlib:ms_transform">ms_transform manual page</seealso>. + specifications is described in the <seealso + marker="erts:match_spec"><c>ERTS User's Guide</c></seealso>. To simplify + the writing of a match specification, they can also be written as + <c>fun/1</c>. For details, see module + <seealso marker="stdlib:ms_transform">ms_transform</seealso> + in application STDLIB. + </p> + + <p>Click button <em>Start Trace</em> to start the trace. + By default, trace output is written to a new window. Tracing is stopped + when the window is closed, or when clicking button <em>Stop Trace</em>. + Trace output can be changed with menu <em>Options > Output</em>. + The trace settings, including match specifications, can be saved to, + or loaded from, a file. + </p> + <p>For details about tracing, see module <seealso + marker="runtime_tools:dbg">dbg</seealso> in application Runtime_Tools + and in section "Match specifications in Erlang" in + <seealso marker="erts:match_spec"><c>ERTS User's Guide</c></seealso> + and in module + <seealso marker="stdlib:ms_transform"><c>ms_transform</c></seealso> + in application STDLIB. </p> </section> </chapter> diff --git a/lib/observer/doc/src/part.xml b/lib/observer/doc/src/part.xml index 27b4e93d2d..d8ec7664d9 100644 --- a/lib/observer/doc/src/part.xml +++ b/lib/observer/doc/src/part.xml @@ -29,9 +29,8 @@ <rev></rev> </header> <description> - <p>The <em>Observer</em> application contains tools for tracing - and investigation of distributed systems.</p> </description> + <xi:include href="introduction_ug.xml"/> <xi:include href="observer_ug.xml"/> <xi:include href="ttb_ug.xml"/> <xi:include href="etop_ug.xml"/> diff --git a/lib/observer/doc/src/ref_man.xml b/lib/observer/doc/src/ref_man.xml index 03d7dbe9df..37e20b2643 100644 --- a/lib/observer/doc/src/ref_man.xml +++ b/lib/observer/doc/src/ref_man.xml @@ -30,10 +30,7 @@ <file>application.sgml</file> </header> <description> - <p>The <em>Observer</em> application contains tools for tracing - and investigation of distributed systems.</p> - <br></br> - </description> + </description> <xi:include href="observer_app.xml"/> <xi:include href="observer.xml"/> <xi:include href="ttb.xml"/> diff --git a/lib/observer/doc/src/ttb.xml b/lib/observer/doc/src/ttb.xml index 0a50a20716..2b637551db 100644 --- a/lib/observer/doc/src/ttb.xml +++ b/lib/observer/doc/src/ttb.xml @@ -4,8 +4,7 @@ <erlref> <header> <copyright> - <year>2002</year> - <year>2013</year> + <year>2002</year><year>2016</year> <holder>Ericsson AB, All Rights Reserved</holder> </copyright> <legalnotice> @@ -25,27 +24,28 @@ </legalnotice> <title>ttb</title> - <prepared>Siri hansen, Bartlomiej Puzon</prepared> + <prepared>Siri Hansen, Bartlomiej Puzon</prepared> <responsible></responsible> <docno>1</docno> <approved></approved> <checked></checked> <date>2010-08-13</date> <rev>PA1</rev> - <file>ttb.sgml</file> + <file>ttb.xml</file> </header> <module>ttb</module> <modulesummary>A base for building trace tools for distributed systems.</modulesummary> <description> - <p>The Trace Tool Builder <c>ttb</c> is a base for building trace + <p>The Trace Tool Builder, <c>ttb</c>, is a base for building trace tools for distributed systems. </p> - <p>When using <c>ttb</c>, <c>dbg</c> shall not be used in parallel.</p> + <p>When using <c>ttb</c>, do not use module <c>dbg</c> in application + Runtime_Tools in parallel.</p> </description> <funcs> <func> <name>start_trace(Nodes, Patterns, FlagSpec, Opts) -> Result</name> - <fsummary>Start a trace port on each given node.</fsummary> + <fsummary>Start a trace port on each specified node.</fsummary> <type> <v>Result = see p/2</v> <v>Nodes = see tracer/2</v> @@ -57,48 +57,56 @@ </type> <desc> <p>This function is a shortcut allowing to start a trace with one command. Each - tuple in <c>Patterns</c> is converted to list which is in turn passed to - <c>ttb:tpl</c>. - The call:</p><code type="none"> -ttb:start_trace([Node, OtherNode], -[{mod, foo, []}, {mod, bar, 2}], -{all, call}, -[{file, File}, {handler,{fun myhandler/4, S}}])</code> - <p>is equivalent to</p> <code type="none"> -ttb:start_trace([Node, OtherNode], [{file, File}, {handler,{fun myhandler/4, S}}]), + tuple in <c>Patterns</c> is converted to a list, which in turn is passed to + <c>ttb:tpl/2,3,4</c>.</p> + <p>The call:</p> + <pre> +> <input>ttb:start_trace([Node, OtherNode], + [{mod, foo, []}, {mod, bar, 2}], + {all, call}, + [{file, File}, {handler,{fun myhandler/4, S}}]).</input></pre> + <p> is equivalent to:</p> + <pre> +> <input>ttb:start_trace([Node, OtherNode], + [{file, File}, {handler,{fun myhandler/4, S}}]), ttb:tpl(mod, foo, []), ttb:tpl(mod, bar, 2, []), -ttb:p(all, call)</code> +ttb:p(all, call).</input></pre> </desc> </func> + <func> <name>tracer() -> Result</name> - <fsummary>This is equivalent to tracer(node()).</fsummary> + <fsummary>Equivalent to tracer(node()).</fsummary> <desc> - <p>This is equivalent to <c>tracer(node())</c>.</p> + <p>Equivalent to <c>tracer(node())</c>.</p> </desc> </func> + <func> <name>tracer(Shortcut) -> Result</name> - <fsummary>Handy shortcuts for common tracing settings</fsummary> + <fsummary>Handy shortcuts for common tracing settings.</fsummary> <type> <v>Shortcut = shell | dbg</v> </type> <desc> + <p>Handy shortcuts for common tracing settings.</p> <p><c>shell</c> is equivalent to <c>tracer(node(),[{file, {local, "ttb"}}, shell])</c>.</p> <p><c>dbg</c> is equivalent to <c>tracer(node(),[{shell, only}])</c>.</p> </desc> </func> + <func> <name>tracer(Nodes) -> Result</name> - <fsummary>This is equivalent to tracer(Nodes,[]).</fsummary> + <fsummary>Equivalent to tracer(Nodes,[]).</fsummary> <desc> - <p>This is equivalent to <c>tracer(Nodes,[])</c>.</p> + <p>Equivalent to <c>tracer(Nodes,[])</c>.</p> </desc> </func> + <func> <name>tracer(Nodes,Opts) -> Result</name> - <fsummary>Start a trace port on each given node.</fsummary> + <fsummary>Start a trace port on each specified node.</fsummary> <type> <v>Result = {ok, ActivatedNodes} | {error,Reason}</v> <v>Nodes = atom() | [atom()] | all | existing | new</v> @@ -120,98 +128,109 @@ ttb:p(all, call)</code> <v>ShellSpec = true | false | only</v> </type> <desc> - <p>This function starts a file trace port on all given nodes - and also points the system tracer for sequential tracing to + <p>Starts a file trace port on all specified nodes + and points the system tracer for sequential tracing to the same port. </p> - <p>The given <c>Filename</c> will be prefixed with the node - name. Default <c>Filename</c> is "ttb". - </p> - <p><c>File={wrap,Filename,Size,Count}</c> can be used if - the size of the trace logs must be limited. Default values are - <c>Size=128*1024</c> and <c>Count=8</c>. - </p> - <p>When tracing diskless nodes, <c>ttb</c> must be started + <p><em>Options:</em></p> + <taglist> + <tag><c>Filename</c></tag> + <item><p>The specified <c>Filename</c> is prefixed with the node name. + Default <c>Filename</c> is <c>ttb</c>.</p></item> + <tag><c>File={wrap,Filename,Size,Count}</c></tag> + <item><p>Can be used if the size of the trace logs must be limited. + Default values are + <c>Size=128*1024</c> and <c>Count=8</c>.</p></item> + <tag><c>Client</c></tag> + <item><p>When tracing diskless nodes, <c>ttb</c> must be started from an external "trace control node" with disk access, and <c>Client</c> must be <c>{local, File}</c>. All trace information is then sent to the trace control node where - it is written to file. - </p> - <p>The <c>process_info</c> option indicates if process - information should be collected. If <c>PI = true</c> (which is + it is written to file.</p></item> + <tag><c>process_info</c></tag> + <item><p>Indicates if process + information is to be collected. If <c>PI = true</c> (which is default), each process identifier <c>Pid</c> is replaced by a tuple <c>{Pid,ProcessInfo,Node}</c>, where <c>ProcessInfo</c> - is the process' registered name its globally registered name, - or its initial function. It is possible to turn off this - functionality by setting <c>PI = false</c>. - </p> - <p>The <c>{shell, ShellSpec}</c> option indicates that the trace messages should - be printed on the console as they are received by the tracing - process. This implies <c>{local, File}</c> trace client. If the ShellSpec - is <c>only</c> (instead of <c>true</c>), no trace logs are stored. - </p> - <p>The <c>shell</c> option is a shortcut for <c>{shell, true}</c>.</p> - <p>The <c>timer</c> option indicates that the trace should be + is the registered process name, its globally registered name, + or its initial function. To turn off this functionality, + set <c>PI = false</c>.</p></item> + <tag><c>{shell, ShellSpec}</c></tag> + <item><p>Indicates that trace messages are to be printed on the + console as they are received by the tracing process. This implies + trace client <c>{local, File}</c>. If <c>ShellSpec</c> + is <c>only</c> (instead of <c>true</c>), no trace logs are stored.</p></item> + <tag><c>shell</c></tag> + <item><p>Shortcut for <c>{shell, true}</c>.</p></item> + <tag><c>timer</c></tag> + <item><p>Indicates that the trace is to be automatically stopped after <c>MSec</c> milliseconds. <c>StopOpts</c> - are passed to <c>ttb:stop/2</c> command if specified (default is <c>[]</c>). - Note that the timing is approximate, as delays related to + are passed to command <c>ttb:stop/2</c> if specified (default is <c>[]</c>). + Notice that the timing is approximate, as delays related to network communication are always present. The timer starts after - <c>ttb:p/2</c> is issued, so you can set up your trace patterns before. - </p> - <p>The <c>overload_check</c> option allows to enable overload + <c>ttb:p/2</c> is issued, so you can set up your trace patterns before.</p></item> + <tag><c>overload_check</c></tag> + <item><p>Allows to enable overload checking on the nodes under trace. <c>Module:Function(check)</c> - is performed each <c>MSec</c> milliseconds. If the check returns - <c>true</c>, the tracing is disabled on a given node.<br/> - <c>Module:Function</c> should be able to handle at least three - atoms: <c>init</c>, <c>check</c> and <c>stop</c>. <c>init</c> and - <c>stop</c> give the user a possibility to initialize and clean - up the check environment.<br/> - When a node gets overloaded, it is not possible to issue <c>ttb:p</c> - nor any command from the <c>ttb:tp</c> family, as it would lead to + is performed each <c>MSec</c> millisecond. If the check returns + <c>true</c>, the tracing is disabled on a specified node.</p> + <p><c>Module:Function</c> must be able to handle at least three + atoms: <c>init</c>, <c>check</c>, and <c>stop</c>. <c>init</c> and + <c>stop</c> allows you to initialize and clean + up the check environment.</p> + <p>When a node gets overloaded, it is not possible to issue <c>ttb:p/2</c> + or any command from the <c>ttb:tp/2,3,4</c> family, as it would lead to inconsistent tracing state (different trace specifications on - different node). - </p> - <p>The <c>flush</c> option periodically flushes all file trace - port clients (see <c>dbg:flush_trace_port/1</c>). When enabled, - the buffers are freed each <c>MSec</c> milliseconds. This option is - not allowed with <c>{file, {local, File}}</c> tracing. - </p> - <p><c>{resume, FetchTimeout}</c> enables the autoresume feature. - Whenever enabled, remote nodes try to reconnect to the controlling node - in case they were restarted. The feature requires <c>runtime_tools</c> - application to be started (so it has to be present in the <c>.boot</c> - scripts if the traced nodes run with embedded erlang). If this is - not possible, resume may be performed manually by starting - <c>runtime_tools</c> remotely using <c>rpc:call/4</c>.<br/> - <c>ttb</c> tries to fetch all logs from a reconnecting node before - reinitializing the trace. This has to finish within FetchTimeout milliseconds - or is aborted<br/> - By default, autostart information is stored in a file called + different nodes).</p></item> + <tag><c>flush</c></tag> + <item><p>Periodically flushes all file trace + port clients (see + <seealso marker="runtime_tools:dbg#flush_trace_port/1"> + <c>dbg:flush_trace_port/1</c></seealso>). When enabled, + the buffers are freed each <c>MSec</c> millisecond. This option is + not allowed with <c>{file, {local, File}}</c> tracing.</p></item> + <tag><c>{resume, FetchTimeout}</c></tag> + <item><p>Enables the autoresume feature. + When enabled, remote nodes try to reconnect to the controlling node + if they are restarted. The feature requires application Runtime_Tools + to be started (so it has to be present in the <c>.boot</c> + scripts if the traced nodes run with embedded Erlang). If this is + not possible, resume can be performed manually by starting + <c>Runtime_Tools</c> remotely using + <seealso marker="kernel:rpc#call/4"><c>rpc:call/4</c></seealso>.</p> + <p><c>ttb</c> tries to fetch all logs from a reconnecting node before + reinitializing the trace. This must finish within <c>FetchTimeout</c> + milliseconds or is aborted.</p> + <p>By default, autostart information is stored in a file named <c>ttb_autostart.bin</c> on each node. If this is not desired - (i.e. on diskless nodes), a custom module to handle autostart + (for example, on diskless nodes), a custom module handling autostart information storage and retrieval can be provided by specifying - <c>ttb_autostart_module</c> environment variable for the <c>runtime_tools</c> - application. The module has to respond to the following API:</p> - <taglist> + environment variable <c>ttb_autostart_module</c> for the application + Runtime_Tools. The module must respond to the following API:</p> + <taglist> <tag><c>write_config(Data) -> ok</c></tag> - <item>Store the provided data for further retrieval. It is + <item><p>Stores the provided data for further retrieval. It is important to realize that the data storage used must not - be affected by the node crash.</item> + be affected by the node crash.</p></item> <tag><c>read_config() -> {ok, Data} | {error, Error}</c></tag> - <item>Retrieve configuration stored with <c>write_config(Data)</c>.</item> + <item><p>Retrieves configuration stored with <c>write_config(Data)</c>.</p></item> <tag><c>delete_config() -> ok</c></tag> - <item>Delete configuration stored with <c>write_config(Data)</c>. - Note that after this call any subsequent calls to <c>read_config</c> - must return <c>{error, Error}</c>. + <item><p>Deletes configuration stored with <c>write_config(Data)</c>. + Notice that after this call any subsequent calls to <c>read_config</c> + must return <c>{error, Error}</c>.</p> </item> - </taglist> - <p>The <c>resume</c> option implies the default <c>FetchTimeout</c>, which is + </taglist> + <p><c>resume</c> implies the default <c>FetchTimeout</c>, which is 10 seconds</p> + </item> + </taglist> + </desc> </func> + <func> <name>p(Procs,Flags) -> Return</name> - <fsummary>Sets the given trace flags on the given processes.</fsummary> + <fsummary>Set the specified trace flags on the specified processes.</fsummary> <type> <v>Return = {ok,[{Procs,MatchDesc}]}</v> <v>Procs = Process | [Process] | all | new | existing</v> @@ -219,95 +238,101 @@ ttb:p(all, call)</code> <v>Flags = Flag | [Flag]</v> </type> <desc> - <p>This function sets the given trace flags on the given - processes. The <c>timestamp</c> flag is always turned on. + <p>Sets the specified trace flags on the specified + processes. Flag <c>timestamp</c> is always turned on. </p> - <p>Please turn to the Reference manual for module <c>dbg</c> - for details about the possible trace flags. The parameter - <c>MatchDesc</c> is the same as returned from <c>dbg:p/2</c></p> - <p>Processes can be given as registered names, globally - registered names or process identifiers. If a registered name - is given, the flags are set on processes with this name on all + <p>See the Reference Manual for module + <seealso marker="runtime_tools:dbg"><c>dbg</c></seealso> + and the possible trace flags. Parameter + <c>MatchDesc</c> is the same as returned from + <c>dbg:p/2</c>.</p> + <p>Processes can be specified as registered names, globally + registered names, or process identifiers. If a registered name + is specified, the flags are set on processes with this name on all active nodes.</p> - <p>Issuing this command starts the timer for this trace if - <c>timer</c> option was specified with <c>tracer/2</c>. + <p>Issuing this command starts the timer for this trace if option + <c>timer</c> is specified with <c>tracer/2</c>. </p> </desc> </func> + <func> <name>tp, tpl, ctp, ctpl, ctpg</name> <fsummary>Set and clear trace patterns.</fsummary> <desc> - <p>These functions should be used in combination with the - <c>call</c> trace flag for setting and clearing trace - patterns. When the <c>call</c> trace flag is set on a process, - function calls will be traced on that process if a trace - pattern has been set for the called function. Trace patterns - specifies how to trace a function by using match + <p>These functions are to be used with + trace flag <c>call</c> for setting and clearing trace + patterns. When trace flag <c>call</c> is set on a process, + function calls are traced on that process if a trace + pattern is set for the called function. Trace patterns + specify how to trace a function by using match specifications. Match specifications are described in the - User's Guide for the erlang runtime system <c>erts</c>. + <seealso marker="erts:users_guide"><c>ERTS User's Guide</c></seealso>. </p> <p>These functions are equivalent to the corresponding - functions in <c>dbg</c>, but all calls are stored in the - history. The history buffer makes it easy to create config - files so that the same trace environment can be setup several - times, e.g. if you want to compare two test runs. It also + functions in module + <seealso marker="runtime_tools:dbg">dbg</seealso>, + but all calls are stored in the + history. The history buffer makes it easy to create configuration + files; the same trace environment can be set up many + times, for example, to compare two test runs. It also reduces the amount of typing when using <c>ttb</c> from the - erlang shell. + Erlang shell. </p> <taglist> <tag><c>tp</c></tag> - <item>Set trace pattern on global function calls</item> + <item><p>Sets trace patterns on global function calls.</p></item> <tag><c>tpl</c></tag> - <item>Set trace pattern on local and global function calls</item> + <item><p>Sets trace patterns on local and global function calls.</p></item> <tag><c>ctp</c></tag> - <item>Clear trace pattern on local and global function - calls</item> + <item><p>Clears trace patterns on local and global function + calls.</p></item> <tag><c>ctpl</c></tag> - <item>Clear trace pattern on local function calls</item> + <item><p>Clears trace patterns on local function calls.</p></item> <tag><c>ctpg</c></tag> - <item>Clear trace pattern on global function calls</item> + <item><p>Clears trace patterns on global function calls.</p></item> </taglist> - <p>With <c>tp</c> and <c>tpl</c> one of match specification shortcuts - may be used (example: <c>ttb:tp(foo_module, caller)</c>). The shortcuts are:</p> - <taglist> - <tag/> + <p>With <c>tp</c> and <c>tpl</c>, one of the match specification shortcuts + can be used (for example, <c>ttb:tp(foo_module, caller)</c>).</p> + <p>The shortcuts are as follows:</p> + <list type="bulleted"> <item><c>return</c> - for <c>[{'_',[],[{return_trace}]}]</c> (report the return value)</item> - <tag/> <item><c>caller</c> - for <c>[{'_',[],[{message,{caller}}]}]</c> (report the calling function)</item> - <tag/> <item><c>{codestr, Str}</c> - for <c>dbg:fun2ms/1</c> arguments passed as strings (example: <c>"fun(_) -> return_trace() end"</c>) </item> - </taglist> + </list> </desc> </func> + <func> <name>list_history() -> History</name> - <fsummary>Returns all calls stored in history</fsummary> + <fsummary>Return all calls stored in history.</fsummary> <type> <v>History = [{N,Func,Args}]</v> </type> <desc> <p>All calls to <c>ttb</c> is stored in the history. This function returns the current content of the history. Any entry - can be re-executed with <c>run_history/1</c> or stored in a - config file with <c>write_config/2/3</c>.</p> + can be reexecuted with <c>run_history/1</c> or stored in a + configuration file with <c>write_config/2,3</c>.</p> </desc> </func> + <func> <name>run_history(N) -> ok | {error, Reason}</name> - <fsummary>Executes one entry of the history</fsummary> + <fsummary>Execute one entry of the history.</fsummary> <type> <v>N = integer() | [integer()]</v> </type> <desc> - <p>Executes the given entry or entries from the history - list. History can be listed with <c>list_history/0</c>.</p> + <p>Executes the specified entry or entries from the history + list. To list history, use <c>list_history/0</c>.</p> </desc> </func> + <func> <name>write_config(ConfigFile,Config)</name> <fsummary>Equivalent to write_config(ConfigFile,Config,[]).</fsummary> @@ -315,9 +340,10 @@ ttb:p(all, call)</code> <p>Equivalent to <c>write_config(ConfigFile,Config,[])</c>.</p> </desc> </func> + <func> <name>write_config(ConfigFile,Config,Opts) -> ok | {error,Reason}</name> - <fsummary>Creates a config file.</fsummary> + <fsummary>Create a configuration file.</fsummary> <type> <v>ConfigFile = string()</v> <v>Config = all | [integer()] | [{Mod,Func,Args}]</v> @@ -328,92 +354,97 @@ ttb:p(all, call)</code> <v>Opt = append</v> </type> <desc> - <p>This function creates or extends a config file which can be + <p>Creates or extends a configuration file, which can be used for restoring a specific configuration later. </p> - <p>The content of the config file can either be fetched from - the history or given directly as a list of + <p>The contents of the configuration file can either be fetched from + the history or specified directly as a list of <c>{Mod,Func,Args}</c>. </p> - <p>If the complete history is to be stored in the config file - <c>Config</c> should be <c>all</c>. If only a selected number - of entries from the history should be stored, <c>Config</c> - should be a list of integers pointing out the entries to be + <p>If the complete history is to be stored in the configuration file, + <c>Config</c> must be <c>all</c>. If only a selected number + of entries from the history are to be stored, <c>Config</c> + must be a list of integers pointing out the entries to be stored. </p> - <p>If <c>Opts</c> is not given or if it is <c>[]</c>, + <p>If <c>Opts</c> is not specified or if it is <c>[]</c>, <c>ConfigFile</c> is deleted and a new file is created. If - <c>Opts = [append]</c>, <c>ConfigFile</c> will not be deleted. - The new information will be appended at the end of the file.</p> + <c>Opts = [append]</c>, <c>ConfigFile</c> is not deleted. + The new information is appended at the end of the file.</p> </desc> </func> + <func> <name>run_config(ConfigFile) -> ok | {error,Reason}</name> - <fsummary>Executes all entries in a config file.</fsummary> + <fsummary>Execute all entries in a configuration file.</fsummary> <type> <v>ConfigFile = string()</v> </type> <desc> - <p>Executes all entries in the given config file. Note that the history - of the last trace is always available in the file named - <c>ttb_last_config</c>.</p> + <p>Executes all entries in the specified configuration file. + Notice that the history of the last trace is always available + in file <c>ttb_last_config</c>.</p> </desc> </func> + <func> <name>run_config(ConfigFile,NumList) -> ok | {error,Reason}</name> - <fsummary>Executes selected entries from a config file.</fsummary> + <fsummary>Execute selected entries from a configuration file.</fsummary> <type> <v>ConfigFile = string()</v> <v>NumList = [integer()]</v> </type> <desc> - <p>Executes selected entries from the given config + <p>Executes selected entries from the specified configuration file. <c>NumList</c> is a list of integers pointing out the entries to be executed. </p> - <p>The content of a config file can be listed with + <p>To list the contents of a configuration file, use <c>list_config/1</c>.</p> - <p> Note that the history - of the last trace is always available in the file named - <c>ttb_last_config</c>.</p> + <p>Notice that the history of the last trace is always available + in file <c>ttb_last_config</c>.</p> </desc> </func> + <func> <name>list_config(ConfigFile) -> Config | {error,Reason}</name> - <fsummary>Lists all entries in a config file.</fsummary> + <fsummary>List all entries in a configuration file.</fsummary> <type> <v>ConfigFile = string()</v> <v>Config = [{N,Func,Args}]</v> </type> <desc> - <p>Lists all entries in the given config file.</p> + <p>Lists all entries in the specified configuration file.</p> </desc> </func> + <func> <name>write_trace_info(Key,Info) -> ok</name> - <fsummary>Writes any information to the <c>.ti</c>file.</fsummary> + <fsummary>Write any information to file <c>.ti</c>.</fsummary> <type> <v>Key = term()</v> <v>Info = Data | fun() -> Data</v> <v>Data = term()</v> </type> <desc> - <p>The <c>.ti</c> file contains <c>{Key,ValueList}</c> - tuples. This function adds <c>Data</c> to the ValueList + <p>File <c>.ti</c> contains <c>{Key,ValueList}</c> + tuples. This function adds <c>Data</c> to the <c>ValueList</c> associated with <c>Key</c>. All information written with this - function will be included in the call to the format handler.</p> + function is included in the call to the format handler.</p> </desc> </func> + <func> <name>seq_trigger_ms() -> MatchSpec</name> - <fsummary>Equivalent to seq_trigger_ms(all)</fsummary> + <fsummary>Equivalent to seq_trigger_ms(all).</fsummary> <desc> - <p>Equivalent to <c>seq_trigger_ms(all)</c></p> + <p>Equivalent to <c>seq_trigger_ms(all)</c>.</p> </desc> </func> + <func> <name>seq_trigger_ms(Flags) -> MatchSpec</name> - <fsummary>Returns a match_spec() which starts sequential tracing</fsummary> + <fsummary>Return a match_spec() which starts sequential tracing.</fsummary> <type> <v>MatchSpec = match_spec()</v> <v>Flags = all | SeqTraceFlag | [SeqTraceFlag]</v> @@ -421,54 +452,55 @@ ttb:p(all, call)</code> </type> <desc> <p>A match specification can turn on or off sequential - tracing. This function returns a match specification which - turns on sequential tracing with the given <c>Flags</c>. + tracing. This function returns a match specification, which + turns on sequential tracing with the specified <c>Flags</c>. </p> - <p>This match specification can be given as the last argument - to <c>tp</c> or <c>tpl</c>. The activated <c>Item</c> will - then become a <em>trigger</em> for sequential tracing. This - means that if the item is called on a process with the - <c>call</c> trace flag set, the process will be "contaminated" - with the seq_trace token. + <p>This match specification can be specified as the last argument + to <c>tp</c> or <c>tpl</c>. The activated <c>Item</c> + then becomes a <em>trigger</em> for sequential tracing. This + means that if the item is called on a process with trace flag + <c>call</c> set, the process is "contaminated" + with token <c>seq_trace</c>. </p> <p>If <c>Flags = all</c>, all possible flags are set. </p> - <p>Please turn to the reference manual for the - <em><c>seq_trace</c></em> module in the <em><c>kernel</c></em> - application to see the possible values for - <c>SeqTraceFlag</c>. For a description of the match_spec() - syntax, please turn to the <em>User's guide</em> for the - runtime system (<em>erts</em>). The chapter <em>Match Specification in Erlang</em> explains the general match - specification "language". + <p>The possible values for <c>SeqTraceFlag</c> are available in + <seealso marker="kernel:seq_trace"><c>seq_trace</c></seealso>.</p> + <p>For a description of the <c>match_spec()</c> syntax, + see section + <seealso marker="erts:match_spec"><c>Match Specifications in Erlang</c></seealso> + in <c>ERTS</c>, which explains the general match specification "language". </p> <note> <p>The <em>system tracer</em> for sequential tracing is automatically initiated by <c>ttb</c> when a trace port is - started with <c>ttb:tracer/0/1/2</c>.</p> + started with <c>ttb:tracer/0,1,2</c>.</p> </note> - <p>Example of how to use the <c>seq_trigger_ms/0/1</c> function:</p> - <code type="none"> -(tiger@durin)5> ttb:tracer(). + <p>An example of how to use function <c>seq_trigger_ms/0,1</c> follows:</p> + <pre> +(tiger@durin)5> <input>ttb:tracer().</input> {ok,[tiger@durin]} -(tiger@durin)6> ttb:p(all,call). +(tiger@durin)6> <input>ttb:p(all,call).</input> {ok,{[all],[call]}} -(tiger@durin)7> ttb:tp(mod,func,ttb:seq_trigger_ms()). +(tiger@durin)7> <input>ttb:tp(mod,func,ttb:seq_trigger_ms()).</input> {ok,[{matched,1},{saved,1}]} -(tiger@durin)8> </code> - <p>Whenever <c>mod:func(...)</c> is called after this, the - seq_trace token will be set on the executing process.</p> +(tiger@durin)8></pre> + <p>Whenever <c>mod:func(...)</c> is called after this, + token <c>seq_trace</c> is set on the executing process.</p> </desc> </func> + <func> <name>stop()</name> - <fsummary>Equivalent to stop([])</fsummary> + <fsummary>Equivalent to stop([]).</fsummary> <desc> <p>Equivalent to <c>stop([])</c>.</p> </desc> </func> + <func> <name>stop(Opts) -> stopped | {stopped, Dir}</name> - <fsummary>Stop tracing and fetch/format logs from all nodes</fsummary> + <fsummary>Stop tracing and fetch/format logs from all nodes.</fsummary> <type> <v>Opts = Opt | [Opt]</v> <v>Opt = nofetch | {fetch_dir, Dir} | format | {format, FormatOpts} | return_fetch_dir</v> @@ -485,88 +517,103 @@ ttb:p(all, call)</code> form <c>yyyymmdd-hhmmss</c>. Even logs from nodes on the same machine as the trace control node are moved to this directory. The history list is saved to a file named <c>ttb_last_config</c> - for further reference (as it will be not longer accessible - through history and configuration management functions (like + for further reference (as it is no longer accessible + through history and configuration management functions, like <c>ttb:list_history/0</c>). </p> - <p>The <c>nofetch</c> option indicates that trace logs shall not be - collected after tracing is stopped. - </p> - <p>The <c>{fetch, Dir}</c> option allows to specify the directory + <p><em>Options:</em></p> + <taglist> + <tag><c>nofetch</c></tag> + <item><p>Indicates that trace logs are not to be + collected after tracing is stopped.</p></item> + <tag><c>{fetch, Dir}</c></tag> + <item><p>Allows specification of the directory to fetch the data to. If the directory already exists, an - error is thrown. - </p> - <p>The <c>format</c> option indicates that the trace logs - shall be formatted after tracing is stopped. All logs in the fetch directory will be merged. - You may use <c>{format, FormatOpts}</c> to pass additional - arguments to <c>format/2</c>.</p> - <p>The <c>return_fetch_dir</c> option indicates that the return value - should be <c>{stopped, Dir}</c> and not just <c>stopped</c>. - This implies <c>fetch</c>. - </p> + error is thrown.</p></item> + <tag><c>format</c></tag> + <item><p>Indicates the trace logs to be formatted after tracing + is stopped. All logs in the fetch directory are merged.</p></item> + <tag><c>return_fetch_dir</c></tag> + <item><p>Indicates the return value + to be <c>{stopped, Dir}</c> and not just <c>stopped</c>. + This implies <c>fetch</c>.</p></item> + </taglist> + </desc> </func> + <func> <name>get_et_handler()</name> - <fsummary>Returns <c>et</c> handler.</fsummary> + <fsummary>Return the <c>et</c> handler.</fsummary> <desc> - <p>The <c>et</c> handler returned by the function may be used with <c>format/2</c> - or <c>tracer/2</c>. Example: <c>ttb:format(Dir, [{handler, ttb:get_et_handler()}])</c>.</p> + <p>Returns the <c>et</c> handler, which can be used with <c>format/2</c> + or <c>tracer/2</c>.</p> + <p>Example: <c>ttb:format(Dir, [{handler, ttb:get_et_handler()}])</c>.</p> </desc> </func> + <func> <name>format(File)</name> - <fsummary>Same as <c>format(File,[])</c>.</fsummary> + <fsummary>Equivalent to <c>format(File,[])</c>.</fsummary> <desc> - <p>Same as <c>format(File,[])</c>.</p> + <p>Equivalent to <c>format(File,[])</c>.</p> </desc> </func> + <func> <name>format(File,Options) -> ok | {error, Reason}</name> - <fsummary>Format a binary trace log</fsummary> + <fsummary>Format a binary trace log.</fsummary> <type> <v>File = string() | [string()]</v> - <d>This can be the name of a binary log, a list of such logs or the name of a directory containing one or more binary logs.</d> + <d>This can be the name of a binary log, a list of such logs, + or the name of a directory containing one or more binary logs.</d> <v>Options = Opt | [Opt]</v> <v>Opt = {out,Out} | {handler,FormatHandler} | disable_sort</v> <v>Out = standard_io | string()</v> <v>FormatHandler = {Function, InitialState}</v> <v>Function = fun(Fd,Trace,TraceInfo,State) -> State</v> <v>Fd = standard_io | FileDescriptor</v> - <d>This is the file descriptor of the destination file <c>Out</c></d> + <d>File descriptor of the destination file <c>Out</c>.</d> <v>Trace = tuple()</v> - <d>This is the trace message. Please turn to the Reference manual for the <c>erlang</c>module for details.</d> + <d>The trace message. For details, see the Reference Manual for + module <c>erlang</c>.</d> <v>TraceInfo = [{Key,ValueList}]</v> - <d>This includes the keys <c>flags</c>, <c>client</c> and <c>node</c>, and if <c>handler</c> is given as option to the tracer function, this is also included. In addition all information written with the <c>write_trace_info/2</c>function is included. </d> + <d>Includes the keys <c>flags</c>, <c>client</c>, and <c>node</c>. + If <c>handler</c> is specified as option to the tracer function, this + is also included. Also, all information written with function + <c>write_trace_info/2</c> is included.</d> </type> <desc> - <p>Reads the given binary trace log(s). The logs are processed - in the order of their timestamp as long as <c>disable_sort</c> - option is not given. + <p>Reads the specified binary trace log(s). The logs are processed + in the order of their time stamps as long as option <c>disable_sort</c> + is not specified. </p> <p>If <c>FormatHandler = {Function,InitialState}</c>, - <c>Function</c> will be called for each trace message. If - <c>FormatHandler = get_et_handler()</c>, <c>et_viewer</c> in - the <em>Event Tracer</em> application (<c>et</c>) is used for presenting + <c>Function</c> is called for each trace message.</p> + <p>If <c>FormatHandler = get_et_handler()</c>, <c>et_viewer</c> in + application ET is used for presenting the trace log graphically. <c>ttb</c> provides a few different - filters which can be selected from the Filter menu in the - <c>et_viewer</c>. If <c>FormatHandler</c> is not given, a - default handler is used which presents each trace message as a - line of text. + filters that can be selected from menu <em>Filters and scaling</em> + in the <c>et_viewer</c>.</p> + <p>If <c>FormatHandler</c> is not specified, a + default handler is used presenting each trace message as a + text line. </p> - <p>The state returned from each call of <c>Function</c> is passed to the next call, - even if next call is to format a message from another log file. + <p>The state returned from each call of <c>Function</c> is passed to + the next call, even if the next call is to format a message from another + log file. </p> - <p>If <c>Out</c> is given, <c>FormatHandler</c> gets the + <p>If <c>Out</c> is specified, <c>FormatHandler</c> gets the file descriptor to <c>Out</c> as the first parameter. </p> - <p><c>Out</c> is ignored if <c>et</c> format handler is used. + <p><c>Out</c> is ignored if the <c>et</c> format handler is used. </p> - <p>Wrap logs can be formatted one by one or all in one go. To - format one of the wrap logs in a set, give the exact name of - the file. To format the whole set of wrap logs, give the name - with '*' instead of the wrap count. See examples in the - <c>ttb</c> User's Guide.</p> + <p>Wrap logs can be formatted one by one or all at once. To + format one of the wrap logs in a set, specify the exact file name. + To format the whole set of wrap logs, specify the name + with <c>*</c> instead of the wrap count. For examples, see the + <seealso marker="ttb_ug#format"><c>User's Guide</c></seealso>. + </p> </desc> </func> </funcs> diff --git a/lib/observer/doc/src/ttb_ug.xml b/lib/observer/doc/src/ttb_ug.xml index e2a28d67d0..34591ae8de 100644 --- a/lib/observer/doc/src/ttb_ug.xml +++ b/lib/observer/doc/src/ttb_ug.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2002</year><year>2013</year> + <year>2002</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -32,78 +32,85 @@ <section> <title>Introduction</title> - <p>The Trace Tool Builder is a base for building trace tools for - single node or distributed erlang systems. It requires the - <c>runtime_tools</c> application to be available on the traced + <p>Trace Tool Builder is a base for building trace tools for + single node or distributed Erlang systems. It requires the + Runtime_Tools application to be available on the traced node. </p> - <p>The main features of the Trace Tool Builder are:</p> + <p>The following are the main features of Trace Tool Builder:</p> <list type="bulleted"> - <item>Start tracing to file ports on several nodes with one + <item>Start tracing to file ports on many nodes with one function call.</item> - <item>Write additional information to a trace information file, + <item>Write more information to a trace information file, which is read during formatting.</item> - <item>Restoring of previous configuration by maintaining a + <item>Restore previous configuration by maintaining a history buffer and handling configuration files.</item> - <item>Some simple support for sequential tracing.</item> - <item>Formatting of binary trace logs and merging of logs from + <item>Provide some simple support for sequential tracing.</item> + <item>Format binary trace logs and merge logs from multiple nodes.</item> </list> - <p>The intention of the Trace Tool Builder is to serve - as a base for tailor made trace tools, but you may use it directly - from the erlang shell (it may mimic <c>dbg</c> behaviour while - still providing useful additions like match specification shortcuts). - The application only - allows the use of file port tracer, so if you would like - to use other types of trace clients you will be better off - using <c>dbg</c> directly instead.</p> + <p>The intention of Trace Tool Builder is to serve + as a base for tailor-made trace tools, but it can also be used directly + from the Erlang shell (it can mimic <c>dbg</c> behaviour while + still providing useful additions, such as match specification shortcuts). + Trace Tool Builder only allows the use of file port tracer, so to use + other types of trace clients it is better to use <c>dbg</c> directly.</p> </section> <section> <title>Getting Started</title> - <p>The <c>ttb</c> module is the interface to all functions in the - Trace Tool Builder. To get started the least you need to do is to - start a tracer with <c>ttb:tracer/0/1/2</c>, and set the required - trace flags on the processes you want to trace with - <c>ttb:p/2</c>. Then, when the tracing is completed, you must stop - the tracer with <c>ttb:stop/0/1</c> and format the trace log with - <c>ttb:format/1/2</c> (as long as there is anything to format, of - course). + <p>Module <c>ttb</c> is the interface to all functions in + Trace Tool Builder.</p> + <p>To get started, the least you need to do is to + start a tracer with + <seealso marker="ttb#tracer/0"><c>ttb:tracer/0,1,2</c></seealso>, + and set the required + trace flags on the processes you want to trace with + <seealso marker="ttb#p/2"><c>ttb:p/2</c></seealso>.</p> + <p>When the tracing is completed, stop the tracer with + <seealso marker="ttb#stop/0"><c>ttb:stop/0,1</c></seealso> + and format the trace log with + <seealso marker="ttb#format/1"><c>ttb:format/1,2</c></seealso> + (if there is anything to format). </p> - <p><c>ttb:tracer/0/1/2</c> opens a trace port on each node - that shall be traced. By default, trace messages are written - to binary files on remote nodes(the binary trace log). - </p> - <p><c>ttb:p/2</c> specifies which processes shall be - traced. Trace flags given in this call specify what to trace on - each process. You can call this function several times if you like - different trace flags to be set on different processes. - </p> - <p>If you want to trace function calls (i.e. if you have the - <c>call</c> trace flag set on any of your processes), you must + <p><em>Useful functions:</em></p> + <taglist> + <tag><c>ttb:tracer/0,1,2</c></tag> + <item><p>Opens a trace port on each node to be traced. By default, + trace messages are written to binary files on remote nodes (the + binary trace log).</p></item> + <tag><c>ttb:p/2</c></tag> + <item><p>Specifies the processes to be traced. Trace flags specified + in this call specify what to trace on each process. This function can be + called many times if you like different trace flags to be set on different + processes.</p></item> + <tag><c>ttb:tp/2,3,4</c> or <c>ttb:tpl/2,3,4</c></tag> + <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 - <c>ttb:tp</c> or <c>ttb:tpl</c>. A function is only traced if it - has a trace pattern. The trace pattern specifies how to trace the + <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>. + 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 - described in the User's Guide for the erlang runtime system - <c>erts</c>. - </p> - <p><c>ttb:stop/0/1</c> stops tracing on all nodes, deletes all - trace patterns and flushes the trace port buffer. - </p> - <p><c>ttb:format/1/2</c> translates the binary trace logs into - something readable. By default <c>ttb</c> presents each trace - message as a line of text, but you can also write your own handler - to make more complex interpretations of the trace information. A - trace log can even be presented graphically via the Event Tracer - application. Note that if you give the <c>format</c> option to - <c>ttb:stop/1</c> the formatting is automatically done when - stopping <c>ttb</c>. - </p> - + described in the + <seealso marker="erts:users_guide">ERTS User's Guide</seealso>.</p></item> + <tag><c>ttb:stop/0,1</c></tag> + <item><p>Stops tracing on all nodes, deletes all trace patterns, and + flushes the trace port buffer.</p></item> + <tag><c>ttb:format/1/2</c></tag> + <item><p>Translates the binary trace logs into something readable. + By default, <c>ttb</c> presents each trace message as a line of text, + but you can also write your own handler to make more complex interpretations + of the trace information. A trace log can also be presented graphically + with application Event Tracer (ET).</p> + <p>If option <c>format</c> is specified to <c>ttb:stop/1</c>, the formatting + is automatically done when stopping <c>ttb</c>.</p></item> + </taglist> + <section> - <title>Example: Tracing the local node from the erlang shell</title> - <p>This small module is used in the example:</p> + <title>Tracing Local Node from Erlang Shell</title> + <p>The following small module is used in the subsequent example:</p> <code type="none"> -module(m). -export([f/0]). @@ -114,25 +121,25 @@ f() -> From ! {self(),Now} end. </code> <p>The following example shows the basic use of <c>ttb</c> from - the erlang shell. Default options are used both for starting the - tracer and for formatting (the custom fetch dir is however provided). - This gives a trace log named <c>Node-ttb</c> in the newly-created - directory, where <c>Node</c> is the name of the node. The + the Erlang shell. Default options are used both for starting the + tracer and for formatting (the custom fetch directory is however provided). + This gives a trace log named <c>Node-ttb</c> in the newly created + directory, where <c>Node</c> is the node name. The default handler prints the formatted trace messages in the - shell.</p> - <code type="none"><![CDATA[ + shell:</p> + <pre> (tiger@durin)47> %% First I spawn a process running my test function -(tiger@durin)47> Pid = spawn(m,f,[]). -<0.125.0> +(tiger@durin)47> <input>Pid = spawn(m,f,[]).</input> +<0.125.0> (tiger@durin)48> (tiger@durin)48> %% Then I start a tracer... -(tiger@durin)48> ttb:tracer(). +(tiger@durin)48> <input>ttb:tracer().</input> {ok,[tiger@durin]} (tiger@durin)49> (tiger@durin)49> %% and activate the new process for tracing (tiger@durin)49> %% function calls and sent messages. -(tiger@durin)49> ttb:p(Pid,[call,send]). -{ok,[{<0.125.0>,[{matched,tiger@durin,1}]}]} +(tiger@durin)49> <input>ttb:p(Pid,[call,send]).</input> +{ok,[{<0.125.0>,[{matched,tiger@durin,1}]}]} (tiger@durin)50> (tiger@durin)50> %% Here I set a trace pattern on erlang:now/0 (tiger@durin)50> %% The trace pattern is a simple match spec @@ -140,33 +147,33 @@ f() -> (tiger@durin)50> %% traced. Refer to the reference_manual for (tiger@durin)50> %% the full list of match spec shortcuts (tiger@durin)50> %% available. -(tiger@durin)51> ttb:tp(erlang,now,return). +(tiger@durin)51> <input>ttb:tp(erlang,now,return).</input> {ok,[{matched,tiger@durin,1},{saved,1}]} (tiger@durin)52> (tiger@durin)52> %% I run my test (i.e. send a message to (tiger@durin)52> %% my new process) -(tiger@durin)52> Pid ! self(). -<0.72.0> +(tiger@durin)52> <input>Pid ! self().</input> +<0.72.0> (tiger@durin)53> (tiger@durin)53> %% And then I have to stop ttb in order to flush (tiger@durin)53> %% the trace port buffer -(tiger@durin)53> ttb:stop([return, {fetch_dir, "fetch"}]). +(tiger@durin)53> <input>ttb:stop([return, {fetch_dir, "fetch"}]).</input> {stopped, "fetch"} (tiger@durin)54> (tiger@durin)54> %% Finally I format my trace log -(tiger@durin)54> ttb:format("fetch"). -({<0.125.0>,{m,f,0},tiger@durin}) call erlang:now() -({<0.125.0>,{m,f,0},tiger@durin}) returned from erlang:now/0 -> +(tiger@durin)54> <input>ttb:format("fetch").</input> +({<0.125.0>,{m,f,0},tiger@durin}) call erlang:now() +({<0.125.0>,{m,f,0},tiger@durin}) returned from erlang:now/0 -> {1031,133451,667611} -({<0.125.0>,{m,f,0},tiger@durin}) <0.72.0> ! -{<0.125.0>,{1031,133451,667611}} -ok ]]></code> +({<0.125.0>,{m,f,0},tiger@durin}) <0.72.0> ! +{<0.125.0>,{1031,133451,667611}} +ok</pre> </section> <section> - <title>Example: Build your own tool</title> - <p>This small example shows a simple tool for "debug tracing", - i.e. tracing of function calls with return values.</p> + <title>Build Your Own Tool</title> + <p>The following example shows a simple tool for "debug tracing", + that is, tracing of function calls with return values:</p> <code type="none"><![CDATA[ -module(mydebug). -export([start/0,trc/1,stop/0,format/1]). @@ -228,124 +235,127 @@ do_print(Out,{trace_ts,P,return_from,{M,F,A},R,Ts},N) -> "Return value :~p~n~n", [N,Ts,P,M,F,A,R]). ]]></code> <p>To distinguish trace logs produced with this tool from other - logs, the <c>file</c> option is used in <c>tracer/2</c>. The - logs will therefore be fetched to a directory named + logs, option <c>file</c> is used in + <seealso marker="ttb#tracer/2"><c>tracer/2</c></seealso>. The + logs are therefore fetched to a directory named <c>ttb_upload_debug_log-YYYYMMDD-HHMMSS</c> </p> - <p>By using the <c>handler</c> option when starting the tracer, + <p>By using option <c>handler</c> when starting the tracer, the information about how to format the file is stored in the trace information file (<c>.ti</c>). This is not necessary, as - it might be given at the time of formatting instead. It can - however be useful if you e.g. want to automatically format your - trace logs by using the <c>format</c> option in - <c>ttb:stop/1</c>. It also means that you don't need any - knowledge of the content of a binary log to be able to format it - the way it was intended. If the <c>handler</c> option is given - both when starting the tracer and when formatting, the one given - when formatting is used. + it can be specified when formatting instead. However, It can + be useful if you, for example, want to format trace logs automatically + using option <c>format</c> in <c>ttb:stop/1</c>. Also, you do not need + any knowledge of the content of a binary log to format it the way it + is intended. If option <c>handler</c> is specified both when starting + the tracer and when formatting, the one specified when formatting is used. </p> - <p>The <c>call</c> trace flag is set on all processes. This - means that any function activated with the <c>trc/1</c> command - will be traced on all existing and new processes. + <p>Trace flag <c>call</c> is set on all processes. This + means that any function activated with command <c>trc/1</c> + is traced on all existing and new processes. </p> </section> </section> <section> - <title>Running the Trace Tool Builder against a remote node</title> + <title>Running Trace Tool Builder against Remote Node</title> <p>The Observer application might not always be available on the - node that shall be traced (in the following called the "traced - node"). It is still possible to run the Trace Tool Builder from + node to be traced (in the following called the "traced + node"). However, Trace Tool Builder can still be run from another node (in the following called the "trace control node") as - long as + long as the following is fulfilled: </p> <list type="bulleted"> <item>The Observer application is available on the trace control node.</item> - <item>The Runtime Tools application is available on both the + <item>The Runtime_Tools application is available on both the trace control node and the traced node.</item> </list> - <p>If the Trace Tool Builder shall be used against a remote node, + <p>If Trace Tool Builder is to be used against a remote node, it is highly recommended to start the trace control node as <em>hidden</em>. This way it can connect to the traced node - without the traced node "seeing" it, i.e. if the <c>nodes()</c> - BIF is called on the traced node, the trace control node will not - show. To start a hidden node, add the <c>-hidden</c> option to the - <c>erl</c> command, e.g.</p> - <code type="none"> -% erl -sname trace_control -hidden </code> + without being "seen" by it, that is, if the <c>nodes()</c> + BIF is called on the traced node, the trace control node does not + show. To start a hidden node, add option <c>-hidden</c> to the + <c>erl</c> command, for example:</p> + <pre> +% <input>erl -sname trace_control -hidden</input></pre> <section> - <title>Diskless node</title> + <title>Diskless Node</title> <p>If the traced node is diskless, <c>ttb</c> must be started from - a trace control node with disk access, and the <c>file</c> option - must be given to the <c>tracer/2</c> function with the value - <c>{local, File}</c>, e.g.</p> - <code type="none"> -(trace_control@durin)1> ttb:tracer(mynode@diskless,{file,{local, -{wrap,"mytrace"}}}). -{ok,[mynode@diskless]} </code> + a trace control node with disk access, and option <c>file</c> + must be specified to function <c>tracer/2</c> with value + <c>{local, File}</c>, for example:</p> + <pre> +(trace_control@durin)1> <input>ttb:tracer(mynode@diskless, + {file,{local,{wrap,"mytrace"}}}).</input> +{ok,[mynode@diskless]}</pre> </section> </section> <section> - <title>Additional tracing options</title> - <p>When setting up a trace, several features may be turned on:</p> + <title>More Tracing Options</title> + <p>When setting up a trace, the following features can also be activated:</p> <list type="bulleted"> - <item>time-constrained tracing,</item> - <item>overload protection,</item> - <item>autoresuming.</item> + <item>Time-constrained tracing</item> + <item>Overload protection</item> + <item>Autoresume</item> + <item><c>dbg</c> mode</item> </list> <section> - <title>Time-constrained tracing</title> - <p>Sometimes, it may be helpful to enable trace for a - given period of time (i.e. to monitor a system for 24 hours - or half of a second). This may be done by issuing additional - <c>{timer, TimerSpec}</c> option. If <c>TimerSpec</c> has the + <title>Time-Constrained Tracing</title> + <p>It can sometimes be helpful to enable trace for a + specified period of time (for example, to monitor a system for 24 hours + or half a second). This can be done with option + <c>{timer, TimerSpec}</c>. If <c>TimerSpec</c> has the form of <c>MSec</c>, the trace is stopped after <c>MSec</c> - milliseconds using <c>ttb:stop/0</c>. If any additional options - are provided (<c>TimerSpec = {MSec, Opts}</c>), <c>ttb:stop/1</c> - is called instead with <c>Opts</c> as the arguments. The timer - is started with <c>ttb:p/2</c>, so any trace patterns should - be set up before. <c>ttb:start_trace/4</c> - always sets up all pattern before invoking <c>ttb:p/2</c>. - Note that due to network and processing delays the the period - of tracing is approximate. - The example below shows how to set up a trace which will be - automatically stopped and formatted after 5 seconds - </p><code> -(tiger@durin)1>ttb:start_trace([node()], - [{erlang, now,[]}], - {all, call}, - [{timer, {5000, format}}]). -</code> + milliseconds using + <seealso marker="ttb#stop/0"><c>ttb:stop/0</c></seealso>. If more + options are provided (<c>TimerSpec = {MSec, Opts}</c>), + <seealso marker="ttb#stop/1"><c>ttb:stop/1</c></seealso> + is called instead with <c>Opts</c> as argument.</p> + <p>The timer is started with + <seealso marker="ttb#p/2"><c>ttb:p/2</c></seealso>, so any trace patterns + must be set up in advance. + <seealso marker="ttb#start_trace/4"><c>ttb:start_trace/4</c></seealso> + always sets up all patterns before invoking <c>ttb:p/2</c>.</p> + <p>The following example shows how to set up a trace that is + automatically stopped and formatted after 5 seconds: + </p><pre> +(tiger@durin)1> <input>ttb:start_trace([node()], + [{erlang, now,[]}], + {all, call}, + [{timer, {5000, format}}]).</input></pre> + <note><p>Because of network and processing delays, the period + of tracing is approximate.</p></note> + </section> <section> - <title>Overload protection</title> - <p>When tracing live systems, special care needs to be always taken - not to overload a node with too heavy tracing. <c>ttb</c> provides - the <c>overload</c> option to help to address the problem.</p> - <p><c>{overload, MSec, Module, Function}</c> instructs the ttb backend - (called <c>observer_backend</c>, part of the <c>runtime_tools</c> - application) to perform overload check every <c>MSec</c> milliseconds. - If the check (namely <c>Module:Function(check)</c>) returns + <title>Overload Protection</title> + <p>When tracing live systems, always take special care to not + overload a node with too heavy tracing. <c>ttb</c> provides + option <c>overload</c> to address this problem.</p> + <p><c>{overload, MSec, Module, Function}</c> instructs the <c>ttb</c> back end + (a part of the <seealso marker="runtime_tools:index">Runtime_Tools</seealso> + application) to perform overload check every <c>MSec</c> millisecond. + If the check (named <c>Module:Function(check)</c>) returns <c>true</c>, tracing is disabled on the selected node.</p> <p>Overload protection activated on one node does not affect other nodes, where the tracing continues as normal. - <c>ttb:stop/0/1</c> fetches data from all clients, including everything - that has been collected before overload protection was activated. - Note that - changing trace details (with <c>ttb:p</c> and <c>ttb:tp/tpl...</c>) - once overload protection gets activated in one of the traced - nodes is not permitted in order not to allow trace setup - to be inconsistent between nodes. - </p> - <p><c>Module:Function</c> provided with the <c>overload</c> option must - handle three calls: <c>init</c>, <c>check</c> and <c>stop</c>. <c>init</c> - and <c>stop</c> allows to perform some setup and teardown required by - the check. An overload check module could look like this (note that - <c>check</c> is always called by the same process, so <c>put</c> and - <c>get</c> are possible). - </p><code> + <c>ttb:stop/0,1</c> fetches data from all clients, including everything + collected before the activation of overload protection.</p> + + <note><p> + It is not allowed to change trace details + (with <c>ttb:p</c> and <c>ttb:tp/tpl...</c>) once overload + protection is activated in one of the traced nodes. This is to + avoid trace setup being inconsistent between nodes.</p></note> + + <p><c>Module:Function</c> provided with option <c>overload</c> must + handle three calls: <c>init</c>, <c>check</c>, and <c>stop</c>. <c>init</c> + and <c>stop</c> allow some setup and teardown required by + the check. An overload check module can look as follows: + </p><code type="none"> -module(overload). -export([check/1]). @@ -362,33 +372,37 @@ check(check) -> end; check(stop) -> get(pid) ! stop.</code> + <note><p> + <c>check</c> is always called by the same process, so <c>put</c> and + <c>get</c> are possible.</p></note> </section> <section> <title>Autoresume</title> - <p>It is possible that a node (probably a buggy one, hence traced) - crashes. In order to automatically resume tracing on the node - as soon as it gets back, <c>resume</c> has to be used. When - it is, the failing node tries to reconnect - to trace control node as soon as <c>runtime tools</c> is started. - This implies that <c>runtime_tools</c> must be included in - other node's startup chain (if it is not, one could still - resume tracing by starting <c>runtime_tools</c> manually, - i.e. by an RPC call).</p> - <p>In order not to loose the data that the failing node stored - up to the point of crash, the control node will try to fetch - it before restarting trace. This must happen within the allowed - time frame or is aborted (default is 10 seconds, can be customized with - <c>{resume, MSec}</c>). The data fetched this way is then - merged with all other traces.</p> - <p>Autostart feature requires additional data to be stored on + <p>A node can crash (probably a buggy one, hence traced). + Use <c>resume</c> to resume tracing on the node automatically + when it gets back. The failing node then tries to reconnect + to trace control node when <c>Runtime_Tools</c> is started. + This implies that <c>Runtime_Tools</c> must be included in + the startup chain of other nodes (if not, you can still + resume tracing by starting <c>Runtime_Tools</c> manually, + that is, by an RPC call).</p> + <p>To not lose the data that the failing node stored + up to the point of crash, the control node tries to fetch + it before restarting trace. This must occur within the allowed + time frame, otherwise it is aborted (default is 10 seconds, but it + can be changed with <c>{resume, MSec}</c>). The data fetched + this way is then merged with all other traces.</p> + <p>The autostart feature requires more data to be stored on traced nodes. By default, the data is stored automatically - to the file called "ttb_autostart.bin" in the traced node's cwd. - Users may decide to change this behaviour (i.e. on diskless + to the file named "ttb_autostart.bin" in the currect working directory + (cwd) of the traced node. + Users can change this behaviour (that is, on diskless nodes) by specifying their own module to handle autostart data storage and retrieval (<c>ttb_autostart_module</c> - environment variable of <c>runtime_tools</c>). Please see the - ttb's reference manual to see the module's API. This example - shows the default handler</p> + environment variable of <c>runtime_tools</c>). For information + about the API, see module + <seealso marker="ttb"><c>ttb</c></seealso>. + The following example shows the default handler:</p> <code> -module(ttb_autostart). -export([read_config/0, @@ -407,54 +421,60 @@ read_config() -> end. write_config(Data) -> - file:write_file(?AUTOSTART_FILENAME, term_to_binary(Data)). - </code> - <p>Remember that file trace ports buffer the data + file:write_file(?AUTOSTART_FILENAME, term_to_binary(Data)).</code> + + <note><p>Remember that file trace ports buffer the data by default. If the node crashes, trace messages are not - flushed to the binary log. If the chance of failure is - high, it might be a good idea to automatically flush - the buffers every now and then. Passing <c>{flush, MSec}</c> - as one of <c>ttb:tracer/2</c> option flushes all buffers - every <c>MSec</c> milliseconds.</p> + flushed to the binary log. If the risk of failure is + high, it can be a good idea to flush the buffers every + now and then automatically. Passing <c>{flush, MSec}</c> + as an option of <c>ttb:tracer/2</c> flushes all buffers + every <c>MSec</c> millisecond.</p></note> </section> <section> - <title>dbg mode</title> - <p>The <c>{shell, ShellType}</c> option allows to make <c>ttb</c> - operation similar to <c>dbg</c>. Using <c>{shell, true}</c> + <title>dbg Mode</title> + <p>Option <c>{shell, ShellType}</c> allows making <c>ttb</c> + operation similar to + <seealso marker="runtime_tools:dbg"><c>dbg</c></seealso>. + Using <c>{shell, true}</c> displays all trace messages in the shell before storing them. <c>{shell, only}</c> additionally disables message storage - (so that the tool behaves exactly like dbg). This is allowed - only with ip trace ports (<c>{trace, {local, File}}</c>). + (making the tool to behave exactly like <c>dbg</c>). This is + allowed only with IP trace ports (<c>{trace, {local, File}}</c>). </p> - <p>The command <c>ttb:tracer(dbg)</c> is a shortcut for the pure-dbg - mode (<c>{shell, only}</c>).</p> + <p>Command <c>ttb:tracer(dbg)</c> is a shortcut for the pure + <c>dbg</c> mode (<c>{shell, only}</c>).</p> </section> </section> <section> <marker id="trace_info"></marker> - <title>Trace Information and the .ti File</title> - <p>In addition to the trace log file(s), a file with the extension - <c>.ti</c> is created when the Trace Tool Builder is started. This - is the trace information file. It is a binary file, and it + <title>Trace Information and File .ti</title> + <p>In addition to the trace log file(s), a file with extension + <c>.ti</c> is created when Trace Tool Builder is started. This + is the trace information file. It is a binary file, which contains the process information, trace flags used, the name of - the node to which it belongs and all information written with the - <c>write_trace_info/2</c> function. .ti files are always fetched - with other logs when the trace is stopped. + the node to which it belongs, and all information written with + function + <seealso marker="ttb#write_trace_info/2"><c>ttb:write_trace_info/2</c></seealso>. + <c>.ti</c> files are always fetched with other logs when the trace is stopped. </p> <p>Except for the process information, everything in the trace information file is passed on to the handler function when - formatting. The <c>TI</c> parameter is a list of + formatting. Parameter <c>TI</c> is a list of <c>{Key,ValueList}</c> tuples. The keys <c>flags</c>, - <c>handler</c>, <c>file</c> and <c>node</c> are used for + <c>handler</c>, <c>file</c>, and <c>node</c> are used for information written directly by <c>ttb</c>. </p> - <p>You can add information to the trace information file by - calling <c>write_trace_info/2</c>. Note that <c>ValueList</c> - always will be a list, and if you call <c>write_trace_info/2</c> - several times with the same <c>Key</c>, the <c>ValueList</c> will - be extended with a new value each time. Example: + <p>Information to the trace information file by + can be added by calling + <seealso marker="ttb#write_trace_info/2"><c>ttb:write_trace_info/2</c></seealso>. + Notice that <c>ValueList</c> + always is a list, and if you call <c>write_trace_info/2</c> + many times with the same <c>Key</c>, the <c>ValueList</c> is + extended with a new value each time. </p> + <p><em>Example:</em></p> <p><c>ttb:write_trace_info(mykey,1)</c> gives the entry <c>{mykey,[1]}</c> in <c>TI</c>. Another call, <c>ttb:write_trace_info(mykey,2)</c>, changes this entry to @@ -467,15 +487,15 @@ write_config(Data) -> <p>If you want to limit the size of the trace logs, you can use wrap logs. This works almost like a circular buffer. You can specify the maximum number of binary logs and the maximum size of - each log. <c>ttb</c> will create a new binary log each time a log - reaches the maximum size. When the the maximum number of logs are + each log. <c>ttb</c> then creates a new binary log each time a log + reaches the maximum size. When the maximum number of logs are reached, the oldest log is deleted before a new one is created. </p> - <p>Note that the overall size of data generated by ttb may be greater - than the wrap specification would suggest - if a traced node restarts - and autoresume is enabled, old wrap log is always stored and + <note><p>The overall size of data generated by <c>ttb</c> can be greater + than the wrap specification suggests. If a traced node restarts + and autoresume is enabled, the old wrap log is always stored and a new one is created. - </p> + </p></note> <p>Wrap logs can be formatted one by one or all at once. See <seealso marker="#format">Formatting</seealso>. </p> @@ -485,52 +505,61 @@ write_config(Data) -> <marker id="format"></marker> <title>Formatting</title> <p>Formatting can be done automatically when stopping <c>ttb</c> - (see <seealso marker="#fetch_format">Automatically collect and format logs from all nodes</seealso>), or explicitly by calling - the <c>ttb:format/1/2</c> function. + (see section + <seealso marker="#fetch_format">Automatically Collect and Format Logs from All Nodes</seealso>), or explicitly by calling function + <c>ttb:format/1,2</c>. </p> <p>Formatting means to read a binary log and present it in a readable format. You can use the default format handler in <c>ttb</c> to present each trace message as a line of text, or write your own handler to make more complex interpretations of the - trace information. You can even use the Event Tracer <c>et</c> to - present the trace log graphically (see <seealso marker="#et_viewer">Presenting trace logs with Event Tracer</seealso>). + trace information. You can also use application ET to + present the trace log graphically (see section + <seealso marker="#et_viewer">Presenting Trace Logs with Event Tracer</seealso>). </p> - <p>The first argument to <c>ttb:format/1/2</c> specifies which + <p>The first argument to <c>ttb:format/1,2</c> specifies which binary log(s) to format. This is usually the name of a directory - that ttb created during log fetch. Unless there is the <c>disable_sort</c> - option provided, the logs from different files are always sorted - according to timestamp in traces. + that <c>ttb</c> created during log fetch. Unless option + <c>disable_sort</c> is provided, the logs from different files + are always sorted according to time-stamp in traces. </p> <p>The second argument to <c>ttb:format/2</c> is a list of - options. The <c>out</c> option specifies the destination where the - formatted text shall be written. Default destination is - <c>standard_io</c>, but a filename can also be given. The - <c>handler</c> option specifies the format handler to use. If this - option is not given, the <c>handler</c> option given when starting - the tracer is used. If the <c>handler</c> option was not given - when starting the tracer either, a default handler is used, which - prints each trace message as a line of text. The <c>disable_sort</c> - option indicates that there logs should not be merged according to - timestamp, but processed one file after another (this might be - a bit faster). + options as follows: </p> - <p>A format handler is a fun taking four arguments. This fun will - be called for each trace message in the binary log(s). A simple - example which only prints each trace message could be like this:</p> + <taglist> + <tag><c>out</c></tag> + <item><p>Specifies the destination to write the formatted text. + Default destination is <c>standard_io</c>, but a filename can + also be specified.</p></item> + <tag><c>handler</c></tag> + <item><p>Specifies the format handler to use. If this option is + not specified, option <c>handler</c> that is specified when starting + the tracer is used. If option <c>handler</c> is not specified + when starting the tracer either, a default handler is used, which + prints each trace message as a text line.</p></item> + <tag><c>disable_sort</c></tag> + <item><p>Indicates that the logs are not to be merged according to + time-stamp, but processed one file after another (this can be + a bit faster).</p></item> + </taglist> + <p>A format handler is a fun taking four arguments. This fun is + called for each trace message in the binary log(s). A simple + example that only prints each trace message can be as follows:</p> <code type="none"> fun(Fd, Trace, _TraceInfo, State) -> io:format(Fd, "Trace: ~p~n", [Trace]), State end. </code> - <p><c>Fd</c> is the file descriptor for the destination file, or + <p>Here, <c>Fd</c> is the file descriptor for the destination file, or the atom <c>standard_io</c>. <c>_TraceInfo</c> contains information - from the trace information file (see <seealso marker="#trace_info">Trace Information and the .ti File</seealso>). <c>State</c> is a state variable for the format - handler fun. The initial value of the <c>State</c> variable is - given with the handler option, e.g.</p> + from the trace information file (see section + <seealso marker="#trace_info">Trace Information and File .ti</seealso>). <c>State</c> is a state variable for the format + handler fun. The initial value of variable <c>State</c> is + specified with the handler option, for example:</p> <code type="none"> ttb:format("tiger@durin-ttb", [{handler, {{Mod,Fun}, initial_state}}]) ^^^^^^^^^^^^^ </code> - <p>Another format handler could be used to calculate time spent by + <p>Another format handler can be used to calculate the time spent by the garbage collector:</p> <code type="none"> fun(_Fd,{trace_ts,P,gc_start,_Info,StartTs},_TraceInfo,State) -> @@ -541,111 +570,118 @@ fun(_Fd,{trace_ts,P,gc_start,_Info,StartTs},_TraceInfo,State) -> io:format("GC in process ~w: ~w milliseconds~n", [P,Time]), State -- [{P,StartTs}] end </code> - <p>A more refined version of this format handler is the function - <c>handle_gc/4</c> in the module <c>multitrace.erl</c> which can - be found in the <c>src</c> directory of the Observer application. + <p>A more refined version of this format handler is function + <c>handle_gc/4</c> in module <c>multitrace.erl</c> + included in directory <c>src</c> of the Observer application. </p> - <p>The actual trace message is passed as the second argument (<c>Trace</c>). - The possible values of <c>Trace</c> are:</p> + <p>The trace message is passed as the second argument (<c>Trace</c>). + The possible values of <c>Trace</c> are the following:</p> <list type="bulleted"> - <item>all trace messages described in <c>erlang:trace/3</c> documentation, + <item>All trace messages described in + <seealso marker="erts:erlang#trace/3"><c>erlang:trace/3</c></seealso> </item> - <item><c>{drop, N}</c> if ip tracer is used (see <c>dbg:trace_port/2</c>), + <item><c>{drop, N}</c> if IP tracer is used (see + <seealso marker="runtime_tools:dbg#trace_port/2"><c>dbg:trace_port/2</c></seealso>) </item> - <item><c>end_of_trace</c> received once when all trace messages have - been processed.</item> + <item><c>end_of_trace</c> received once when all trace messages are + processed</item> </list> - <p>By giving the format handler <c>ttb:get_et_handler()</c>, you can have the trace - log presented graphically with <c>et_viewer</c> in the Event - Tracer application (see <seealso marker="#et_viewer">Presenting trace logs with Event Tracer</seealso>). + <p>By giving the format handler + <seealso marker="ttb#get_et_handler/0"><c>ttb:get_et_handler()</c></seealso>, + you can have the trace + log presented graphically with <c>et_viewer</c> in the ET + application (see section + <seealso marker="#et_viewer">Presenting Trace Logs with Event Tracer</seealso>). </p> - <p>You may always decide not to format the whole trace data contained - in the fetch directory, but analyze single files instead. In order - to do so, a single file (or list of files) have to be passed as - the first argument to <c>format/1/2</c>.</p> - <p>Wrap logs can be formatted one by one or all in one go. To - format one of the wrap logs in a set, give the exact name of the - file. To format the whole set of wrap logs, give the name with '*' - instead of the wrap count. An example: + <p>You can always decide not to format the whole trace data contained + in the fetch directory, but analyze single files instead. To do so, + a single file (or list of files) must be passed as the first argument + to <c>format/1,2</c>.</p> + <p>Wrap logs can be formatted one by one or all at once. To + format one of the wrap logs in a set, specify the exact file name. + To format the whole set of wrap logs, specify the name with <c>*</c> + instead of the wrap count. </p> + <p><em>Example:</em></p> <p>Start tracing:</p> - <code type="none"> -(tiger@durin)1> ttb:tracer(node(),{file,{wrap,"trace"}}). + <pre> +(tiger@durin)1> <input>ttb:tracer(node(),{file,{wrap,"trace"}}).</input> {ok,[tiger@durin]} -(tiger@durin)2> ttb:p(...) -... </code> - <p>This will give a set of binary logs, like:</p> +(tiger@durin)2> <input>ttb:p(...)</input> +...</pre> + <p>This gives a set of binary logs, for example:</p> <code type="none"> ... </code> <p>Format the whole set of logs:</p> - <code type="none"> -1> ttb:format("tiger@durin-trace.*.wrp"). + <pre> +1> <input>ttb:format("tiger@durin-trace.*.wrp").</input> .... ok -2> </code> +2> </pre> <p>Format only the first log:</p> - <code type="none"> -1> ttb:format("[email protected]"). + <pre> +1> <input>ttb:format("[email protected]").</input> .... ok -2> </code> +2> </pre> <p>To merge all wrap logs from two nodes:</p> - <code type="none"> -1> ttb:format(["tiger@durin-trace.*.wrp","lion@durin-trace.*.wrp"]). + <pre> +1> <input>ttb:format(["tiger@durin-trace.*.wrp","lion@durin-trace.*.wrp"]).</input> .... ok -2> </code> +2> </pre> <section> <marker id="et_viewer"></marker> - <title>Presenting trace logs with Event Tracer</title> - <p>For detailed information about the Event Tracer, please turn - to the User's Guide and Reference Manuals for the <c>et</c> - application. + <title>Presenting Trace Logs with Event Tracer</title> + <p>For detailed information about the Event Tracer, see the + <seealso marker="et:users_guide">ET</seealso> application. </p> - <p>By giving the format handler <c>ttb:get_et_handler()</c>, you can have the - trace log presented graphically with <c>et_viewer</c> in the - Event Tracer application. <c>ttb</c> provides a few different - filters which can be selected from the Filter menu in the - <c>et_viewer</c> window. The filters are names according to the - type of actors they present (i.e. what each vertical line in the - sequence diagram represent). Interaction between actors is shown - as red arrows between two vertical lines, and activities within - an actor are shown as blue text to the right of the actors line. + <p>By giving the format handler + <seealso marker="ttb#get_et_handler/0"><c>ttb:get_et_handler()</c></seealso>, + you can have the trace log presented graphically with + <c>et_viewer</c> in the ET application. + <c>ttb</c> provides filters that can be selected from the + menu <em>Filter</em> in the <c>et_viewer</c> window. The filters + are names according to the type of actors they present + (that is, what each vertical line in the sequence diagram represents). + Interaction between actors is shown as red arrows between two + vertical lines, and activities within an actor are shown as + blue text to the right of the actors line. </p> - <p>The <c>processes</c> filter is the only filter which will - show all trace messages from a trace log. Each vertical line in + <p>The <c>processes</c> filter is the only filter showing all + trace messages from a trace log. Each vertical line in the sequence diagram represents a process. Erlang messages, - spawn and link/unlink are typical interactions between - processes. Function calls, scheduling and garbage collection are - typical activities within a process. <c>processes</c> is the - default filter. + spawn, and link/unlink are typical interactions between + processes. Function calls, scheduling, and garbage collection, + are typical activities within a process. <c>processes</c> is + the default filter. </p> - <p>The rest of the filters will only show function calls and + <p>The remaining filters only show function calls and function returns. All other trace message are discarded. To get - the most out of these filters, <c>et_viewer</c> needs to known + the most out of these filters, <c>et_viewer</c> must know the caller of each function and the time of return. This can be - obtained by using both the <c>call</c> and <c>return_to</c> - flags when tracing. Note that the <c>return_to</c> flag only - works with local call trace, i.e. when trace patterns are set + obtained using both the <c>call</c> and <c>return_to</c> + flags when tracing. Notice that flag <c>return_to</c> only + works with local call trace, that is, when trace patterns are set with <c>ttb:tpl</c>. </p> - <p>The same result can be obtained by using the <c>call</c> flag - only and setting a match specification like this on local or - global function calls:</p> - <code type="none"> -1> dbg:fun2ms(fun(_) -> return_trace(),message(caller()) end). -[{'_',[],[{return_trace},{message,{caller}}]}] </code> - <p>This should however be done with care, since the - <c>{return_trace}</c> function in the match specification will - destroy tail recursiveness. + <p>The same result can be obtained by using the flag <c>call</c> + only and setting a match specification on local or + global function calls as follows:</p> + <pre> +1> <input>dbg:fun2ms(fun(_) -> return_trace(),message(caller()) end).</input> +[{'_',[],[{return_trace},{message,{caller}}]}]</pre> + <p>This must however be done with care, as function + <c>{return_trace}</c> in the match specification + destroys tail recursiveness. </p> <p>The <c>modules</c> filter shows each module as a vertical line in the sequence diagram. External function calls/returns - are shown as interactions between modules and internal function + are shown as interactions between modules, and internal function calls/returns are shown as activities within a module. </p> <p>The <c>functions</c> filter shows each function as a vertical @@ -656,9 +692,9 @@ ok <p>The <c>mods_and_procs</c> and <c>funcs_and_procs</c> filters are equivalent to the <c>modules</c> and <c>functions</c> filters respectively, except that each module or function can - have several vertical lines, one for each process it resides on. + have many vertical lines, one for each process it resides on. </p> - <p>In the next example, modules <c>foo</c> and <c>bar</c> are used:</p> + <p>In the following example, modules <c>foo</c> and <c>bar</c> are used:</p> <code type="none"> -module(foo). -export([start/0,go/0]). @@ -673,8 +709,9 @@ go() -> go -> bar:f1(), go() - end. -</code><code type="none"> + end.</code> + +<code type="none"> -module(bar). -export([f1/0,f3/0]). f1() -> @@ -685,57 +722,56 @@ f2() -> f3() -> ok.</code> - <p>Now let's set up the trace.</p> -<code> -(tiger@durin)1>%%First we retrieve the Pid to limit traced processes set -(tiger@durin)1>Pid = foo:start(). -(tiger@durin)2>%%Now we set up tracing -(tiger@durin)2>ttb:tracer(). -(tiger@durin)3>ttb:p(Pid, [call, return_to, procs, set_on_spawn]). -(tiger@durin)4>ttb:tpl(bar, []). -(tiger@durin)5>%%Invoke our test function and see output with et viewer -(tiger@durin)5>Pid ! go. -(tiger@durin)6>ttb:stop({format, {handler, ttb:get_et_handler()}}). -</code> - - <p>This should render a result similar to the - following: + <p>Setting up the trace:</p> +<pre> +(tiger@durin)1> %%First we retrieve the Pid to limit traced processes set +(tiger@durin)1> <input>Pid = foo:start().</input> +(tiger@durin)2> %%Now we set up tracing +(tiger@durin)2> <input>ttb:tracer().</input> +(tiger@durin)3> <input>ttb:p(Pid, [call, return_to, procs, set_on_spawn]).</input> +(tiger@durin)4> <input>ttb:tpl(bar, []).</input> +(tiger@durin)5> %%Invoke our test function and see output with et viewer +(tiger@durin)5> <input>Pid ! go.</input> +(tiger@durin)6> <input>ttb:stop({format, {handler, ttb:get_et_handler()}}).</input></pre> + + <p>This renders a result similar to the following: </p> - <p></p> <image file="et_processes.gif"> <icaption>Filter: "processes"</icaption> </image> + <p></p> <image file="et_modsprocs.gif"> <icaption>Filter: "mods_and_procs"</icaption> </image> - <p>Note, that we can use <c>ttb:start_trace/4</c> function to help - us here:</p> -<code> -(tiger@durin)1>Pid = foo:start(). -(tiger@durin)2>ttb:start_trace([node()], - [{bar,[]}], - {Pid, [call, return_to, procs, set_on_spawn]} - {handler, ttb:get_et_handler()}). -(tiger@durin)3>Pid ! go. -(tiger@durin)4>ttb:stop(format). -</code> + <p>Notice that function + <seealso marker="ttb#start_trace/4"><c>ttb:start_trace/4</c></seealso> + can be used as help as follows:</p> +<pre> +(tiger@durin)1> <input>Pid = foo:start().</input> +(tiger@durin)2> <input>ttb:start_trace([node()], + [{bar,[]}], + {Pid, [call, return_to, procs, set_on_spawn]} + {handler, ttb:get_et_handler()}).</input> +(tiger@durin)3> <input>Pid ! go.</input> +(tiger@durin)4> <input>ttb:stop(format).</input></pre> </section> </section> <section> <marker id="fetch_format"></marker> - <title>Automatically collect and format logs from all nodes</title> - <p>By default <c>ttb:stop/1</c> fetches trace logs and - trace information files from all nodes. The logs are stored in a - new directory named <c>ttb_upload-Filename-Timestamp</c> under the working - directory of the trace control node. Fetching may be disabled by - providing the <c>nofetch</c> option to <c>ttb:stop/1</c>. User can - specify a fetch directory of his choice passing the - <c>{fetch_dir, Dir}</c> option. + <title>Automatically Collect and Format Logs from All Nodes</title> + <p>By default, + + <seealso marker="ttb#stop/1"><c>ttb:stop/1</c></seealso> fetches trace logs + and trace information files from all nodes. The logs are stored in a + new directory named <c>ttb_upload-Filename-Timestamp</c> under the + working directory of the trace control node. Fetching can be disabled + by providing option <c>nofetch</c> to <c>ttb:stop/1</c>. The user can + specify a fetch directory by passing option <c>{fetch_dir, Dir}</c>. </p> - <p>If the option <c>format</c> is given to <c>ttb:stop/1</c>, the + <p>If option <c>format</c> is specified to <c>ttb:stop/1</c>, the trace logs are automatically formatted after tracing is stopped. </p> @@ -743,116 +779,122 @@ f3() -> <section> <title>History and Configuration Files</title> - <p>For the tracing functionality, <c>dbg</c> could be used instead - of the <c>ttb</c> for setting trace flags on processes and trace - patterns for call trace, i.e. the functions <c>p</c>, <c>tp</c>, - <c>tpl</c>, <c>ctp</c>, <c>ctpl</c> and <c>ctpg</c>. There are only - two things added by <c>ttb</c> for these functions:</p> + <p>For the tracing functionality, + <seealso marker="runtime_tools:dbg"><c>dbg</c></seealso> + can be used instead + of <c>ttb</c> for setting trace flags on processes and trace + patterns for call trace, that is, the functions + <c>p</c>, <c>tp</c>, <c>tpl</c>, <c>ctp</c>, <c>ctpl</c>, and <c>ctpg</c>. Only the + following two things are added by <c>ttb</c> for these functions:</p> <list type="bulleted"> - <item>all calls are stored in the history buffer and can be + <item>All calls are stored in the history buffer and can be recalled and stored in a configuration file. This makes it - easy to setup the same trace environment e.g. if you want to - compare two test runs. It also reduces the amount of - typing when using <c>ttb</c> from the erlang shell;</item> - <item>shortcuts are provided for the most common match - specifications (in order not to force the user to use - <c>dbg:fun2ms</c> continually).</item> + easy to set up the same trace environment, for example, if you + want to compare two test runs. It also reduces the amount of + typing when using <c>ttb</c> from the Erlang shell.</item> + <item>Shortcuts are provided for the most common match + specifications (to not force you to use + <seealso marker="runtime_tools:dbg#fun2ms/1"><c>dbg:fun2ms</c></seealso> + continually).</item> </list> - <p>Use <c>list_history/0</c> to see the content of the history - buffer, and <c>run_history/1</c> to re-execute one of the entries. + <p>Use + <seealso marker="ttb#list_history/0"><c>ttb:list_history/0</c></seealso> + to see the content of the history buffer and + <seealso marker="ttb#run_history/1"><c>ttb:run_history/1</c></seealso> + to re-execute one of the entries. </p> <p>The main purpose of the history buffer is the possibility to create configuration files. Any function stored in the history buffer can be written to a configuration file and used for - creating a specific configuration at any time with one single + creating a specific configuration at any time with a single function call. </p> <p>A configuration file is created or extended with - <c>write_config/2/3</c>. Configuration files are binary files + <seealso marker="ttb#write_config/2"><c>ttb:write_config/2,3</c></seealso>. + Configuration files are binary files and can therefore only be read and written with functions provided by <c>ttb</c>. </p> - <p>You can write the complete content of the history buffer to a - config file by calling - <c>ttb:write_config(ConfigFile,all)</c>. And you can write - selected entries from the history by calling + <p>The complete content of the history buffer can be written to a + configuration file by calling + <c>ttb:write_config(ConfigFile,all)</c>. Selected entries from + the history can be written by calling <c>ttb:write_config(ConfigFile,NumList)</c>, where <c>NumList</c> is a list of integers pointing out the history entries to write. Moreover, the history buffer is always dumped - to <c>ttb_last_config</c> when <c>ttb:stop/0/1</c> is called. + to <c>ttb_last_config</c> when <c>ttb:stop/0,1</c> is called. </p> - <p>User defined entries can also be written to a config file by - calling the function - <c>ttb:write_config(ConfigFile,ConfigList)</c> where + <p>User-defined entries can also be written to a configuration file + by calling function + <c>ttb:write_config(ConfigFile,ConfigList)</c>, where <c>ConfigList</c> is a list of <c>{Module,Function,Args}</c>. </p> <p>Any existing file <c>ConfigFile</c> is deleted and a new file - is created when <c>write_config/2</c> is called. The option - <c>append</c> can be used if you wish to add something at the end - of an existing config file, e.g. + is created when <c>write_config/2</c> is called. Option + <c>append</c> can be used to add something at the end + of an existing configuration file, for example, <c>ttb:write_config(ConfigFile,What,[append])</c>. </p> - <section> - <title>Example: History and configuration files</title> - <p>See the content of the history buffer</p> - <code type="none"><![CDATA[ -(tiger@durin)191> ttb:tracer(). + <p><em>Example:</em></p> + <p>See the content of the history buffer:</p> + <pre> +(tiger@durin)191> <input>ttb:tracer().</input> {ok,[tiger@durin]} -(tiger@durin)192> ttb:p(self(),[garbage_collection,call]). -{ok,{[<0.1244.0>],[garbage_collection,call]}} -(tiger@durin)193> ttb:tp(ets,new,2,[]). +(tiger@durin)192> <input>ttb:p(self(),[garbage_collection,call]).</input> +{ok,{[<0.1244.0>],[garbage_collection,call]}} +(tiger@durin)193> <input>ttb:tp(ets,new,2,[]).</input> {ok,[{matched,1}]} -(tiger@durin)194> ttb:list_history(). +(tiger@durin)194> <input>ttb:list_history().</input> [{1,{ttb,tracer,[tiger@durin,[]]}}, - {2,{ttb,p,[<0.1244.0>,[garbage_collection,call]]}}, - {3,{ttb,tp,[ets,new,2,[]]}}] ]]></code> + {2,{ttb,p,[<0.1244.0>,[garbage_collection,call]]}}, + {3,{ttb,tp,[ets,new,2,[]]}}]</pre> <p>Execute an entry from the history buffer:</p> - <code type="none"><![CDATA[ -(tiger@durin)195> ttb:ctp(ets,new,2). + <pre> +(tiger@durin)195> <input>ttb:ctp(ets,new,2).</input> {ok,[{matched,1}]} -(tiger@durin)196> ttb:list_history(). +(tiger@durin)196> <input>ttb:list_history().</input> [{1,{ttb,tracer,[tiger@durin,[]]}}, - {2,{ttb,p,[<0.1244.0>,[garbage_collection,call]]}}, + {2,{ttb,p,[<0.1244.0>,[garbage_collection,call]]}}, {3,{ttb,tp,[ets,new,2,[]]}}, {4,{ttb,ctp,[ets,new,2]}}] -(tiger@durin)197> ttb:run_history(3). +(tiger@durin)197> <input>ttb:run_history(3).</input> ttb:tp(ets,new,2,[]) -> -{ok,[{matched,1}]} ]]></code> +{ok,[{matched,1}]}</pre> <p>Write the content of the history buffer to a configuration file:</p> - <code type="none"><![CDATA[ -(tiger@durin)198> ttb:write_config("myconfig",all). + <pre> +(tiger@durin)198> <input>ttb:write_config("myconfig",all).</input> ok -(tiger@durin)199> ttb:list_config("myconfig"). +(tiger@durin)199> <input>ttb:list_config("myconfig").</input> [{1,{ttb,tracer,[tiger@durin,[]]}}, - {2,{ttb,p,[<0.1244.0>,[garbage_collection,call]]}}, + {2,{ttb,p,[<0.1244.0>,[garbage_collection,call]]}}, {3,{ttb,tp,[ets,new,2,[]]}}, {4,{ttb,ctp,[ets,new,2]}}, - {5,{ttb,tp,[ets,new,2,[]]}}] ]]></code> + {5,{ttb,tp,[ets,new,2,[]]}}]</pre> <p>Extend an existing configuration:</p> - <code type="none"><![CDATA[ -(tiger@durin)200> ttb:write_config("myconfig",[{ttb,tp,[ets,delete,1,[]]}], -[append]). + <pre> +(tiger@durin)200> <input>ttb:write_config("myconfig",[{ttb,tp,[ets,delete,1,[]]}], +[append]).</input> ok -(tiger@durin)201> ttb:list_config("myconfig"). +(tiger@durin)201> <input>ttb:list_config("myconfig").</input> [{1,{ttb,tracer,[tiger@durin,[]]}}, - {2,{ttb,p,[<0.1244.0>,[garbage_collection,call]]}}, + {2,{ttb,p,[<0.1244.0>,[garbage_collection,call]]}}, {3,{ttb,tp,[ets,new,2,[]]}}, {4,{ttb,ctp,[ets,new,2]}}, {5,{ttb,tp,[ets,new,2,[]]}}, - {6,{ttb,tp,[ets,delete,1,[]]}}] ]]></code> + {6,{ttb,tp,[ets,delete,1,[]]}}]</pre> <p>Go back to a previous configuration after stopping Trace Tool Builder:</p> - <code type="none"><![CDATA[ -(tiger@durin)202> ttb:stop(). + <pre> +(tiger@durin)202> <input>ttb:stop().</input> ok -(tiger@durin)203> ttb:run_config("myconfig"). +(tiger@durin)203> <input>ttb:run_config("myconfig").</input> ttb:tracer(tiger@durin,[]) -> {ok,[tiger@durin]} -ttb:p(<0.1244.0>,[garbage_collection,call]) -> -{ok,{[<0.1244.0>],[garbage_collection,call]}} +ttb:p(<0.1244.0>,[garbage_collection,call]) -> +{ok,{[<0.1244.0>],[garbage_collection,call]}} ttb:tp(ets,new,2,[]) -> {ok,[{matched,1}]} @@ -866,133 +908,135 @@ ttb:tp(ets,new,2,[]) -> ttb:tp(ets,delete,1,[]) -> {ok,[{matched,1}]} -ok ]]></code> +ok</pre> <p>Write selected entries from the history buffer to a configuration file:</p> - <code type="none"><![CDATA[ -(tiger@durin)204> ttb:list_history(). + <pre> +(tiger@durin)204> <input>ttb:list_history().</input> [{1,{ttb,tracer,[tiger@durin,[]]}}, - {2,{ttb,p,[<0.1244.0>,[garbage_collection,call]]}}, + {2,{ttb,p,[<0.1244.0>,[garbage_collection,call]]}}, {3,{ttb,tp,[ets,new,2,[]]}}, {4,{ttb,ctp,[ets,new,2]}}, {5,{ttb,tp,[ets,new,2,[]]}}, {6,{ttb,tp,[ets,delete,1,[]]}}] -(tiger@durin)205> ttb:write_config("myconfig",[1,2,3,6]). +(tiger@durin)205> <input>ttb:write_config("myconfig",[1,2,3,6]).</input> ok -(tiger@durin)206> ttb:list_config("myconfig"). +(tiger@durin)206> <input>ttb:list_config("myconfig").</input> [{1,{ttb,tracer,[tiger@durin,[]]}}, - {2,{ttb,p,[<0.1244.0>,[garbage_collection,call]]}}, + {2,{ttb,p,[<0.1244.0>,[garbage_collection,call]]}}, {3,{ttb,tp,[ets,new,2,[]]}}, {4,{ttb,tp,[ets,delete,1,[]]}}] -(tiger@durin)207> ]]></code> - </section> +(tiger@durin)207></pre> </section> <section> <title>Sequential Tracing</title> <p>To learn what sequential tracing is and how it can be used, - please turn to the reference manual for the - <em><c>seq_trace</c></em> module in the <em><c>kernel</c></em> - application. + see the Reference Manual for + <seealso marker="kernel:seq_trace"><c>seq_trace</c></seealso>. </p> - <p>The support for sequential tracing provided by the Trace Tool - Builder includes </p> + <p>The support for sequential tracing provided by Trace Tool + Builder includes the following:</p> <list type="bulleted"> <item>Initiation of the system tracer. This is automatically - done when a trace port is started with <c>ttb:tracer/0/1/2</c></item> - <item>Creation of match specifications which activates - sequential tracing</item> + done when a trace port is started with + <seealso marker="ttb#tracer/0"><c>ttb:tracer/0,1,2</c></seealso>.</item> + <item>Creation of match specifications that activates + sequential tracing.</item> </list> - <p>Starting sequential tracing requires that a tracer has been - started with the <c>ttb:tracer/0/1/2</c> function. Sequential - tracing can then either be started via a trigger function with a - match specification created with <c>ttb:seq_trigger_ms/0/1</c>, - or directly by using the <c>seq_trace</c> module in the - <c>kernel</c> application. + <p>Starting sequential tracing requires that a tracer is + started with function <c>ttb:tracer/0,1,2</c>. Sequential + tracing can then be started in either of the following ways: </p> + <list type="bulleted"> + <item>Through a trigger function with a match specification + created with + <seealso marker="ttb#seq_trigger_ms/0"><c>ttb:seq_trigger_ms/0,1</c></seealso>.</item> + <item>Directly by using module + <seealso marker="kernel:seq_trace"><c>seq_trace</c></seealso>.</item> + </list> - <section> - <title>Example: Sequential tracing</title> - <p>In the following example, the function + <p><em>Example 1:</em></p> + <p>In the following example, function <c>dbg:get_tracer/0</c> is used as trigger for sequential tracing:</p> - <code type="none"><![CDATA[ -(tiger@durin)110> ttb:tracer(). + <pre> +(tiger@durin)110> <input>ttb:tracer().</input> {ok,[tiger@durin]} -(tiger@durin)111> ttb:p(self(),call). -{ok,{[<0.158.0>],[call]}} -(tiger@durin)112> ttb:tp(dbg,get_tracer,0,ttb:seq_trigger_ms(send)). +(tiger@durin)111> <input>ttb:p(self(),call).</input> +{ok,{[<0.158.0>],[call]}} +(tiger@durin)112> <input>ttb:tp(dbg,get_tracer,0,ttb:seq_trigger_ms(send)).</input> {ok,[{matched,1},{saved,1}]} -(tiger@durin)113> dbg:get_tracer(), seq_trace:reset_trace(). +(tiger@durin)113> <input>dbg:get_tracer(), seq_trace:reset_trace().</input> true -(tiger@durin)114> ttb:stop(format). -({<0.158.0>,{shell,evaluator,3},tiger@durin}) call dbg:get_tracer() -SeqTrace [0]: ({<0.158.0>,{shell,evaluator,3},tiger@durin}) -{<0.237.0>,dbg,tiger@durin} ! {<0.158.0>,{get_tracer,tiger@durin}} +(tiger@durin)114> <input>ttb:stop(format).</input> +({<0.158.0>,{shell,evaluator,3},tiger@durin}) call dbg:get_tracer() +SeqTrace [0]: ({<0.158.0>,{shell,evaluator,3},tiger@durin}) +{<0.237.0>,dbg,tiger@durin} ! {<0.158.0>,{get_tracer,tiger@durin}} [Serial: {0,1}] -SeqTrace [0]: ({<0.237.0>,dbg,tiger@durin}) -{<0.158.0>,{shell,evaluator,3},tiger@durin} ! {dbg,{ok,#Port<0.222>}} +SeqTrace [0]: ({<0.237.0>,dbg,tiger@durin}) +{<0.158.0>,{shell,evaluator,3},tiger@durin} ! {dbg,{ok,#Port<0.222>}} [Serial: {1,2}] ok -(tiger@durin)116> ]]></code> - <p>Starting sequential tracing with a trigger is actually more +(tiger@durin)116></pre> + <p><em>Example 2:</em></p> + <p>Starting sequential tracing with a trigger is more useful if the trigger function is not called directly from the shell, but rather implicitly within a larger system. When calling a function from the shell, it is simpler to start - sequential tracing directly, e.g.</p> - <code type="none"><![CDATA[ -(tiger@durin)116> ttb:tracer(). + sequential tracing directly, for example, as follows:</p> + <pre> +(tiger@durin)116> <input>ttb:tracer().</input> {ok,[tiger@durin]} -(tiger@durin)117> seq_trace:set_token(send,true), dbg:get_tracer(), -seq_trace:reset_trace(). +(tiger@durin)117> <input>seq_trace:set_token(send,true), dbg:get_tracer(), +seq_trace:reset_trace().</input> true -(tiger@durin)118> ttb:stop(format). -SeqTrace [0]: ({<0.158.0>,{shell,evaluator,3},tiger@durin}) -{<0.246.0>,dbg,tiger@durin} ! {<0.158.0>,{get_tracer,tiger@durin}} +(tiger@durin)118> <input>ttb:stop(format).</input> +SeqTrace [0]: ({<0.158.0>,{shell,evaluator,3},tiger@durin}) +{<0.246.0>,dbg,tiger@durin} ! {<0.158.0>,{get_tracer,tiger@durin}} [Serial: {0,1}] -SeqTrace [0]: ({<0.246.0>,dbg,tiger@durin}) -{<0.158.0>,{shell,evaluator,3},tiger@durin} ! {dbg,{ok,#Port<0.229>}} +SeqTrace [0]: ({<0.246.0>,dbg,tiger@durin}) +{<0.158.0>,{shell,evaluator,3},tiger@durin} ! {dbg,{ok,#Port<0.229>}} [Serial: {1,2}] ok -(tiger@durin)120> ]]></code> - <p>In both examples above, the <c>seq_trace:reset_trace/0</c> - resets the trace token immediately after the traced function in - order to avoid lots of trace messages due to the printouts in - the erlang shell. +(tiger@durin)120></pre> + <p>In both previous examples, <c>seq_trace:reset_trace/0</c> + resets the trace token immediately after the traced function + to avoid many trace messages because of the printouts in + the Erlang shell. </p> - <p>All functions in the <c>seq_trace</c> module, except - <c>set_system_tracer/1</c>, can be used after the trace port has - been started with <c>ttb:tracer/0/1/2</c>. + <p>All functions in module <c>seq_trace</c>, except + <c>set_system_tracer/1</c>, can be used after the trace port + is started with <c>ttb:tracer/0,1,2</c>. </p> - </section> </section> <section> - <title>Example: Multipurpose trace tool</title> - <p>The module <c>multitrace.erl</c> which can be found in the - <c>src</c> directory of the Observer application implements a + <title>Multipurpose Trace Tool</title> + <p>Module <c>multitrace</c> in + directory <c>src</c> of the Observer application provides a small tool with three possible trace settings. The trace messages - are written to binary files which can be formatted with the - function <em><c>multitrace:format/1/2</c></em>. + are written to binary files, which can be formatted with + function <c>multitrace:format/1,2</c>: </p> <taglist> - <tag><em><c>multitrace:debug(What)</c></em></tag> - <item>Start calltrace on all processes and trace the given + <tag><c>multitrace:debug(What)</c></tag> + <item><p>Start calltrace on all processes and trace the specified function(s). The format handler used is - <c>multitrace:handle_debug/4</c> which prints each call and - return. <c>What</c> must be an item or a list of items to trace, - given on the format <c>{Module,Function,Arity}</c>, - <c>{Module,Function}</c> or just <c>Module</c>.</item> - <tag><em><c>multitrace:gc(Procs)</c></em></tag> - <item>Trace garbage collection on the given process(es). The - format handler used is <c>multitrace:handle_gc/4</c> which - prints start and stop and the time spent for each GC.</item> - <tag><em><c>multitrace:schedule(Procs)</c></em></tag> - <item>Trace in- and out-scheduling on the given process(es). The - format handler used is <c>multitrace:handle_schedule/4</c> which - prints each in and out scheduling with process, timestamp and + <c>multitrace:handle_debug/4</c> that prints each call and + returns. <c>What</c> must be an item or a list of items to trace, + specified on the format <c>{Module,Function,Arity}</c>, + <c>{Module,Function}</c>, or only <c>Module</c>.</p></item> + <tag><c>multitrace:gc(Procs)</c></tag> + <item><p>Trace garbage collection on the specified process(es). The + format handler used is <c>multitrace:handle_gc/4</c> that + prints start, stop, and the time spent for each garbage collection.</p></item> + <tag><c>multitrace:schedule(Procs)</c></tag> + <item><p>Trace in-scheduling and out-scheduling on the specified process(es). + The format handler used is <c>multitrace:handle_schedule/4</c> that + prints each in-scheduling and out-scheduling with process, time-stamp, and current function. It also prints the total time each traced - process was scheduled in.</item> + process was scheduled in.</p></item> </taglist> </section> </chapter> diff --git a/lib/observer/src/observer_alloc_wx.erl b/lib/observer/src/observer_alloc_wx.erl index 8d5c8a9037..d37623d1cc 100644 --- a/lib/observer/src/observer_alloc_wx.erl +++ b/lib/observer/src/observer_alloc_wx.erl @@ -30,19 +30,23 @@ -record(state, { - offset = 0.0, + time = #ti{}, active = false, parent, - windows, - data = {0, queue:new()}, + wins, + mem, + samples, panel, paint, appmon, async }). --define(ALLOC_W, 1). --define(UTIL_W, 2). +-define(ID_REFRESH_INTERVAL, 102). + +-import(observer_perf_wx, + [make_win/4, setup_graph_drawing/1, refresh_panel/4, interval_dialog/2, + add_data/5, precalc/4]). start_link(Notebook, Parent) -> wx_object:start_link(?MODULE, [Notebook, Parent], []). @@ -51,34 +55,44 @@ init([Notebook, Parent]) -> try Panel = wxPanel:new(Notebook), Main = wxBoxSizer:new(?wxVERTICAL), - Style = ?wxFULL_REPAINT_ON_RESIZE bor ?wxCLIP_CHILDREN, - Carrier = wxPanel:new(Panel, [{winid, ?ALLOC_W}, {style,Style}]), - Utilz = wxPanel:new(Panel, [{winid, ?UTIL_W}, {style,Style}]), BorderFlags = ?wxLEFT bor ?wxRIGHT, - wxSizer:add(Main, Carrier, [{flag, ?wxEXPAND bor BorderFlags bor ?wxTOP}, - {proportion, 1}, {border, 5}]), - - wxSizer:add(Main, Utilz, [{flag, ?wxEXPAND bor BorderFlags}, - {proportion, 1}, {border, 5}]), + Carrier = make_win(alloc, Panel, Main, BorderFlags bor ?wxTOP), + Utilz = make_win(utilz, Panel, Main, BorderFlags), MemWin = {MemPanel,_} = create_mem_info(Panel), wxSizer:add(Main, MemPanel, [{flag, ?wxEXPAND bor BorderFlags bor ?wxBOTTOM}, {proportion, 1}, {border, 5}]), wxWindow:setSizer(Panel, Main), - - PaintInfo = observer_perf_wx:setup_graph_drawing([Carrier, Utilz]), - {Panel, #state{parent=Parent, - panel =Panel, - windows = {Carrier, Utilz, MemWin}, - paint=PaintInfo} + Windows = [Carrier, Utilz], + PaintInfo = setup_graph_drawing(Windows), + {Panel, #state{parent= Parent, + panel = Panel, + wins = Windows, + mem = MemWin, + paint = PaintInfo, + time = setup_time() + } } catch _:Err -> io:format("~p crashed ~p: ~p~n",[?MODULE, Err, erlang:get_stacktrace()]), {stop, Err} end. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +setup_time() -> + Freq = 1, + #ti{fetch=Freq, disp=?DISP_FREQ/Freq}. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +handle_event(#wx{id=?ID_REFRESH_INTERVAL, event=#wxCommand{type=command_menu_selected}}, + #state{panel=Panel, appmon=Old, wins=Wins0, time=#ti{fetch=F0} = Ti0} = State) -> + case interval_dialog(Panel, Ti0) of + Ti0 -> {noreply, State}; + #ti{fetch=F0} = Ti -> %% Same fetch interval force refresh + Wins = [W#win{max=undefined} || W <- Wins0], + {noreply, precalc(State#state{time=Ti, wins=Wins})}; + Ti -> %% Changed fetch interval, drop all data + {noreply, restart_fetcher(Old, State#state{time=Ti})} + end; handle_event(#wx{event=#wxCommand{type=command_menu_selected}}, State = #state{}) -> {noreply, State}; @@ -88,13 +102,11 @@ handle_event(Event, _State) -> %%%%%%%%%% handle_sync_event(#wx{obj=Panel, event = #wxPaint{}},_, - #state{active=Active, offset=Offset, paint=Paint, - windows=Windows, data=Data}) -> + #state{active=Active, time=Ti, paint=Paint, + wins = Windows}) -> %% Sigh workaround bug on MacOSX (Id in paint event is always 0) - Id = if Panel =:= element(?ALLOC_W, Windows) -> alloc; - Panel =:= element(?UTIL_W, Windows) -> utilz - end, - observer_perf_wx:refresh_panel(Panel, Id, Offset, Data, Active, Paint), + Win = lists:keyfind(Panel, #win.panel, Windows), + refresh_panel(Active, Win, Ti, Paint), ok. %%%%%%%%%% handle_call(Event, From, _State) -> @@ -107,24 +119,37 @@ handle_cast(Event, _State) -> handle_info({Key, {promise_reply, {badrpc, _}}}, #state{async=Key} = State) -> {noreply, State#state{active=false, appmon=undefined}}; -handle_info({Key, {promise_reply, SysInfo}}, #state{async=Key, data=Data} = State) -> +handle_info({Key, {promise_reply, SysInfo}}, + #state{async=Key, panel=Panel, samples=Data, active=Active, wins=Wins0, + time=#ti{tick=Tick, disp=Disp0}=Ti} = S0) -> + Disp = trunc(Disp0), + Next = max(Tick - Disp, 0), + erlang:send_after(1000 div ?DISP_FREQ, self(), {refresh, Next}), Info = alloc_info(SysInfo), - update_alloc(State, Info), - {noreply, State#state{offset=0.0, data = add_data(Info, Data), async=undefined}}; + {Wins, Samples} = add_data(Info, Data, Wins0, Ti, Active), + S1 = S0#state{time=Ti#ti{tick=Next}, wins=Wins, samples=Samples, async=undefined}, + if Active -> + update_alloc(S0, Info), + State = precalc(S1), + catch wxWindow:refresh(Panel), + {noreply, State}; + true -> + {noreply, S1} + end; -handle_info({refresh, Seq, Freq, Node}, #state{panel=Panel, appmon=Node, async=Key} = State) -> - wxWindow:refresh(Panel), +handle_info({refresh, Seq}, + State = #state{panel=Panel, appmon=Node, time=#ti{tick=Seq, disp=DispF}=Ti}) + when (Seq+1) < (DispF*1.5) -> Next = Seq+1, - if - Next > Freq, Key =:= undefined -> - erlang:send_after(trunc(1000 / Freq), self(), {refresh, 1, Freq, Node}), + State#state.active andalso (catch wxWindow:refresh(Panel)), + erlang:send_after(1000 div ?DISP_FREQ, self(), {refresh, Next}), + if Seq =:= (trunc(DispF)-1) -> Req = rpc:async_call(Node, observer_backend, sys_info, []), - {noreply, State#state{offset=Seq/Freq, async=Req}}; + {noreply, State#state{time=Ti#ti{tick=Next}, async=Req}}; true -> - erlang:send_after(trunc(1000 / Freq), self(), {refresh, Next, Freq, Node}), - {noreply, State#state{offset=Seq/Freq}} + {noreply, State#state{time=Ti#ti{tick=Next}}} end; -handle_info({refresh, _Seq, _Freq, _Node}, State) -> +handle_info({refresh, _S}, #state{}=State) -> {noreply, State}; handle_info({active, Node}, State = #state{parent=Parent, panel=Panel, appmon=Old}) -> @@ -132,15 +157,9 @@ handle_info({active, Node}, State = #state{parent=Parent, panel=Panel, appmon=Ol try Node = Old, wxWindow:refresh(Panel), - {noreply, State#state{active=true}} + {noreply, precalc(State#state{active=true})} catch _:_ -> - SysInfo = observer_wx:try_rpc(Node, observer_backend, sys_info, []), - Info = alloc_info(SysInfo), - Freq = 6, - erlang:send_after(trunc(1000 / Freq), self(), {refresh, 1, Freq, Node}), - wxWindow:refresh(Panel), - {noreply, State#state{active=true, appmon=Node, offset=0.0, - data = add_data(Info, {0, queue:new()})}} + {noreply, restart_fetcher(Node, State)} end; handle_info(not_active, State = #state{appmon=_Pid}) -> @@ -160,12 +179,21 @@ code_change(_, _, State) -> %%%%%%%%%% -add_data(Stats, {N, Q}) when N > 60 -> - {N, queue:drop(queue:in(Stats, Q))}; -add_data(Stats, {N, Q}) -> - {N+1, queue:in(Stats, Q)}. +restart_fetcher(Node, #state{panel=Panel, wins=Wins0, time=Ti} = State) -> + SysInfo = observer_wx:try_rpc(Node, observer_backend, sys_info, []), + Info = alloc_info(SysInfo), + {Wins, Samples} = add_data(Info, {0, queue:new()}, Wins0, Ti, true), + erlang:send_after(1000 div ?DISP_FREQ, self(), {refresh, 0}), + wxWindow:refresh(Panel), + precalc(State#state{active=true, appmon=Node, time=Ti#ti{tick=0}, + wins=Wins, samples=Samples}). + +precalc(#state{samples=Data0, paint=Paint, time=Ti, wins=Wins0}=State) -> + Wins = [precalc(Ti, Data0, Paint, Win) || Win <- Wins0], + State#state{wins=Wins}. + -update_alloc(#state{windows={_, _, {_, Grid}}}, Fields) -> +update_alloc(#state{mem={_, Grid}}, Fields) -> Max = wxListCtrl:getItemCount(Grid), Update = fun({Name, BS, CS}, Row) -> (Row >= Max) andalso wxListCtrl:insertItem(Grid, Row, ""), @@ -174,7 +202,7 @@ update_alloc(#state{windows={_, _, {_, Grid}}}, Fields) -> wxListCtrl:setItem(Grid, Row, 2, observer_lib:to_str(CS div 1024)), Row + 1 end, - lists:foldl(Update, 0, Fields), + wx:foldl(Update, 0, Fields), Fields. alloc_info(SysInfo) -> @@ -247,11 +275,7 @@ create_mem_info(Parent) -> create_menus(Parent, _) -> - MenuEntries = - [{"File", - [ - ]} - ], - observer_wx:create_menus(Parent, MenuEntries). + View = {"View", [#create_menu{id = ?ID_REFRESH_INTERVAL, text = "Graph Settings"}]}, + observer_wx:create_menus(Parent, [{"File", []}, View]). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/observer/src/observer_app_wx.erl b/lib/observer/src/observer_app_wx.erl index a2b7c21993..40e117357c 100644 --- a/lib/observer/src/observer_app_wx.erl +++ b/lib/observer/src/observer_app_wx.erl @@ -29,7 +29,7 @@ -include("observer_defs.hrl"). %% Import drawing wrappers --import(observer_perf_wx, [haveGC/0, +-import(observer_perf_wx, [haveGC/0, make_gc/2, destroy_gc/1, setPen/2, setFont/3, setBrush/2, strokeLine/5, strokeLines/2, drawRoundedRectangle/6, drawText/4, getTextExtent/2]). @@ -244,28 +244,18 @@ handle_event(Event, _State) -> %%%%%%%%%% handle_sync_event(#wx{event = #wxPaint{}},_, #state{app_w=DA, app=App, sel=Sel, paint=Paint, usegc=UseGC}) -> - %% PaintDC must be created in a callback to work on windows. - IsWindows = element(1, os:type()) =:= win32, - %% Avoid Windows flickering hack - DC = if IsWindows -> wx:typeCast(wxBufferedPaintDC:new(DA), wxPaintDC); - true -> wxPaintDC:new(DA) - end, - IsWindows andalso wxDC:clear(DC), - GC = case UseGC of - true -> - GC0 = ?wxGC:create(DC), - %% Argh must handle scrolling when using ?wxGC - {Sx,Sy} = wxScrolledWindow:calcScrolledPosition(DA, {0,0}), - ?wxGC:translate(GC0, Sx,Sy), - GC0; - false -> - wxScrolledWindow:doPrepareDC(DA,DC), - DC - end, + GC = {GC0, DC} = make_gc(DA, UseGC), + case UseGC of + false -> + wxScrolledWindow:doPrepareDC(DA,DC); + true -> + %% Argh must handle scrolling when using ?wxGC + {Sx,Sy} = wxScrolledWindow:calcScrolledPosition(DA, {0,0}), + ?wxGC:translate(GC0, Sx,Sy) + end, %% Nothing is drawn until wxPaintDC is destroyed. - draw({UseGC, GC}, App, Sel, Paint), - UseGC andalso ?wxGC:destroy(GC), - wxPaintDC:destroy(DC), + draw(GC, App, Sel, Paint), + destroy_gc(GC), ok. %%%%%%%%%% handle_call(Event, From, _State) -> @@ -312,15 +302,10 @@ handle_info({delivery, _Pid, app, _Curr, {[], [], [], []}}, handle_info({delivery, Pid, app, Curr, AppData}, State = #state{panel=Panel, appmon=Pid, current=Curr, usegc=UseGC, app_w=AppWin, paint=#paint{font=Font}}) -> - GC = if UseGC -> ?wxGC:create(AppWin); - true -> wxWindowDC:new(AppWin) - end, - FontW = {UseGC, GC}, - setFont(FontW, Font, {0,0,0}), - App = build_tree(AppData, FontW), - if UseGC -> ?wxGC:destroy(GC); - true -> wxWindowDC:destroy(GC) - end, + GC = make_gc(AppWin, UseGC), + setFont(GC, Font, {0,0,0}), + App = build_tree(AppData, GC), + destroy_gc(GC), setup_scrollbar(AppWin, App), wxWindow:refresh(Panel), wxWindow:layout(Panel), diff --git a/lib/observer/src/observer_defs.hrl b/lib/observer/src/observer_defs.hrl index 1c2fe520b7..c4ba84a8c4 100644 --- a/lib/observer/src/observer_defs.hrl +++ b/lib/observer/src/observer_defs.hrl @@ -49,3 +49,14 @@ -define(LCTRL_WDECR, 4). %% Remove some pixels in column width to avoid creating unnecessary scrollbar -define(SASH_STYLE, ?wxSP_LIVE_UPDATE bor ?wxSP_NOBORDER bor ?wxSP_3DSASH). + +-define(DISP_FREQ, 10). %% per second +-define(FETCH_DATA, 2). %% per second +-define(DISP_SECONDS, 60). + +-record(ti, {tick=0, disp=?DISP_FREQ/?FETCH_DATA, fetch=?FETCH_DATA, secs=?DISP_SECONDS}). + +-record(win, {name, panel, size, geom, + graphs=[], no_samples=0, + max, state, + info=[]}). diff --git a/lib/observer/src/observer_perf_wx.erl b/lib/observer/src/observer_perf_wx.erl index ace0b62c1d..56da5a862a 100644 --- a/lib/observer/src/observer_perf_wx.erl +++ b/lib/observer/src/observer_perf_wx.erl @@ -25,8 +25,9 @@ handle_event/2, handle_sync_event/3, handle_cast/2]). %% Drawing wrappers for DC and GC areas --export([setup_graph_drawing/1, refresh_panel/6, - haveGC/0, +-export([make_win/4, setup_graph_drawing/1, + refresh_panel/4, precalc/4, add_data/5, interval_dialog/2, + haveGC/0, make_gc/2, destroy_gc/1, setPen/2, setFont/3, setBrush/2, strokeLine/5, strokeLines/2, drawRoundedRectangle/6, drawText/4, getTextExtent/2]). @@ -35,13 +36,18 @@ -include_lib("wx/include/wx.hrl"). -include("observer_defs.hrl"). +-define(ID_REFRESH_INTERVAL, 102). + +-define(BW, 5). +-define(BH, 5). + -record(state, { - offset = 0.0, + time = #ti{}, active = false, parent, - windows, - data = {0, queue:new()}, + samples, %% Orig data store + wins=[], %% per window content panel, paint, appmon @@ -51,49 +57,49 @@ -record(paint, {font, small, pen, pen2, pens, usegc = false}). --define(RQ_W, 1). --define(MEM_W, 2). --define(IO_W, 3). - start_link(Notebook, Parent) -> wx_object:start_link(?MODULE, [Notebook, Parent], []). init([Notebook, Parent]) -> - try - Panel = wxPanel:new(Notebook), - Main = wxBoxSizer:new(?wxVERTICAL), + try + Panel = wxPanel:new(Notebook), + Main = wxBoxSizer:new(?wxVERTICAL), + MemIO = wxBoxSizer:new(?wxHORIZONTAL), + + CPU = make_win(runq, Panel, Main, ?wxALL), + MEM = make_win(memory, Panel, MemIO, ?wxLEFT), + IO = make_win(io, Panel, MemIO, ?wxLEFT bor ?wxRIGHT), + + wxSizer:add(Main, MemIO, [{flag, ?wxEXPAND bor ?wxDOWN}, + {proportion, 1}, {border, 5}]), + wxWindow:setSizer(Panel, Main), + Windows = [CPU, MEM, IO], + PaintInfo = setup_graph_drawing(Windows), + + process_flag(trap_exit, true), + State0 = #state{parent=Parent, + panel =Panel, + wins = Windows, + paint=PaintInfo, + samples=reset_data() + }, + {Panel, State0} + catch _:Err -> + io:format("~p crashed ~p: ~p~n",[?MODULE, Err, erlang:get_stacktrace()]), + {stop, Err} + end. + +make_win(Name, Parent, Sizer, Border) -> Style = ?wxFULL_REPAINT_ON_RESIZE bor ?wxCLIP_CHILDREN, - CPU = wxPanel:new(Panel, [{winid, ?RQ_W}, {style,Style}]), - wxSizer:add(Main, CPU, [{flag, ?wxEXPAND bor ?wxALL}, - {proportion, 1}, {border, 5}]), - MemIO = wxBoxSizer:new(?wxHORIZONTAL), - MEM = wxPanel:new(Panel, [{winid, ?MEM_W}, {style,Style}]), - IO = wxPanel:new(Panel, [{winid, ?IO_W}, {style,Style}]), - wxSizer:add(MemIO, MEM, [{flag, ?wxEXPAND bor ?wxLEFT}, - {proportion, 1}, {border, 5}]), - wxSizer:add(MemIO, IO, [{flag, ?wxEXPAND bor ?wxLEFT bor ?wxRIGHT}, - {proportion, 1}, {border, 5}]), - wxSizer:add(Main, MemIO, [{flag, ?wxEXPAND bor ?wxDOWN}, - {proportion, 1}, {border, 5}]), - wxWindow:setSizer(Panel, Main), - - PaintInfo = setup_graph_drawing([CPU, MEM, IO]), - - process_flag(trap_exit, true), - {Panel, #state{parent=Parent, - panel =Panel, - windows = {CPU, MEM, IO}, - paint=PaintInfo - }} - catch _:Err -> - io:format("~p crashed ~p: ~p~n",[?MODULE, Err, erlang:get_stacktrace()]), - {stop, Err} - end. + Panel = wxPanel:new(Parent, [{style,Style}]), + Opts = [{flag, ?wxEXPAND bor Border}, {proportion, 1}, {border, 5}], + wxSizer:add(Sizer, Panel, Opts), + #win{name=Name, panel=Panel}. setup_graph_drawing(Panels) -> IsWindows = element(1, os:type()) =:= win32, IgnoreCB = {callback, fun(_,_) -> ok end}, - Do = fun(Panel) -> + Do = fun(#win{panel=Panel}) -> wxWindow:setBackgroundColour(Panel, ?wxWHITE), wxPanel:connect(Panel, paint, [callback]), IsWindows andalso @@ -117,8 +123,8 @@ setup_graph_drawing(Panels) -> SF = wxFont:new(DefSize-2, DefFamily, ?wxFONTSTYLE_NORMAL, ?wxFONTWEIGHT_NORMAL), {F, SF} end, - BlackPen = wxPen:new({0,0,0}, [{width, 2}]), - Pens = [wxPen:new(Col, [{width, 3}]) || Col <- tuple_to_list(colors())], + BlackPen = wxPen:new({0,0,0}, [{width, 1}]), + Pens = [wxPen:new(Col, [{width, 1}]) || Col <- tuple_to_list(colors())], #paint{usegc = UseGC, font = Font, small = SmallFont, @@ -129,7 +135,16 @@ setup_graph_drawing(Panels) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - +handle_event(#wx{id=?ID_REFRESH_INTERVAL, event=#wxCommand{type=command_menu_selected}}, + #state{panel=Panel, appmon=Old, wins=Wins0, time=#ti{fetch=F0} = Ti0} = State) -> + case interval_dialog(Panel, Ti0) of + Ti0 -> {noreply, State}; + #ti{fetch=F0} = Ti -> %% Same fetch interval force refresh + Wins = [W#win{max=undefined} || W <- Wins0], + {noreply, precalc(State#state{time=Ti, wins=Wins})}; + Ti -> %% Changed fetch interval, drop all data + {noreply, restart_fetcher(node(Old), State#state{time=Ti})} + end; handle_event(#wx{event=#wxCommand{type=command_menu_selected}}, State = #state{}) -> {noreply, State}; @@ -139,41 +154,21 @@ handle_event(Event, _State) -> %%%%%%%%%% handle_sync_event(#wx{obj=Panel, event = #wxPaint{}},_, - #state{active=Active, offset=Offset, paint=Paint, - windows=Windows, data=Data}) -> + #state{active=Active, time=Ti, paint=Paint, wins=Windows}) -> %% Sigh workaround bug on MacOSX (Id in paint event is always 0) %% Panel = element(Id, Windows), - Id = if Panel =:= element(?RQ_W, Windows) -> runq; - Panel =:= element(?MEM_W, Windows) -> memory; - Panel =:= element(?IO_W, Windows) -> io - end, - - refresh_panel(Panel, Id, Offset, Data, Active, Paint), + Win = lists:keyfind(Panel, #win.panel, Windows), + refresh_panel(Active, Win, Ti, Paint), ok. -refresh_panel(Panel, Id, Offset, Data, Active, #paint{usegc=UseGC} = Paint) -> +refresh_panel(Active, #win{name=_Id, panel=Panel}=Win, Ti, #paint{usegc=UseGC}=Paint) -> %% PaintDC must be created in a callback to work on windows. - IsWindows = element(1, os:type()) =:= win32, - DC = if IsWindows -> - %% Ugly hack to aviod flickering on windows, works on windows only - %% But the other platforms are doublebuffered by default - wx:typeCast(wxBufferedPaintDC:new(Panel), wxPaintDC); - true -> - wxPaintDC:new(Panel) - end, - IsWindows andalso wxDC:clear(DC), - GC = if UseGC -> ?wxGC:create(DC); - true -> DC - end, %% Nothing is drawn until wxPaintDC is destroyed. - try - draw(Offset, Id, {UseGC, GC}, Panel, Paint, Data, Active) - catch _:Err -> - io:format("Internal error ~p ~p~n",[Err, erlang:get_stacktrace()]) + GC = make_gc(Panel, UseGC), + if Active -> draw_win(GC, Win, Ti, Paint); + true -> ignore end, - UseGC andalso ?wxGC:destroy(GC), - wxPaintDC:destroy(DC). - + destroy_gc(GC). %%%%%%%%%% handle_call(Event, From, _State) -> @@ -182,41 +177,42 @@ handle_call(Event, From, _State) -> handle_cast(Event, _State) -> error({unhandled_cast, Event}). %%%%%%%%%% -handle_info(Stats = {stats, 1, _, _, _}, - State = #state{panel=Panel, data=Data, active=Active}) -> +handle_info({stats, 1, _, _, _} = Stats, + #state{panel=Panel, samples=Data, active=Active, wins=Wins0, + time=#ti{tick=Tick, disp=Disp0}=Ti} = State0) -> if Active -> + Disp = trunc(Disp0), + Next = max(Tick - Disp, 0), + erlang:send_after(1000 div ?DISP_FREQ, self(), {refresh, Next}), + {Wins, Samples} = add_data(Stats, Data, Wins0, Ti, Active), + State = precalc(State0#state{time=Ti#ti{tick=Next}, wins=Wins, samples=Samples}), wxWindow:refresh(Panel), - Freq = 6, - erlang:send_after(trunc(1000 / Freq), self(), {refresh, 1, Freq}); - true -> ignore - end, - {noreply, State#state{offset=0.0, data = add_data(Stats, Data)}}; - -handle_info({refresh, Seq, Freq}, State = #state{panel=Panel, offset=Prev}) -> - wxWindow:refresh(Panel), - Next = Seq+1, - if Seq > 1, Prev =:= 0.0 -> - %% We didn't have time to handle the refresh {noreply, State}; - Next < Freq -> - erlang:send_after(trunc(1000 / Freq), self(), {refresh, Next, Freq}), - {noreply, State#state{offset=Seq/Freq}}; true -> - {noreply, State#state{offset=Seq/Freq}} + {Wins1, Samples} = add_data(Stats, Data, Wins0, Ti, Active), + Wins = [W#win{max=undefined} || W <- Wins1], + {noreply, State0#state{samples=Samples, wins=Wins, time=Ti#ti{tick=0}}} end; -handle_info({active, Node}, State = #state{parent=Parent, panel=Panel, appmon=Old}) -> +handle_info({refresh, Seq}, #state{panel=Panel, time=#ti{tick=Seq, disp=DispF}=Ti} = State0) + when (Seq+1) < (DispF*1.5) -> + Next = Seq+1, + erlang:send_after(1000 div ?DISP_FREQ, self(), {refresh, Next}), + State = precalc(State0#state{time=Ti#ti{tick=Next}}), + catch wxWindow:refresh(Panel), + {noreply, State}; +handle_info({refresh, _}, State) -> + {noreply, State}; + +handle_info({active, Node}, #state{parent=Parent, panel=Panel, appmon=Old, time=_Ti} = State) -> create_menus(Parent, []), try Node = node(Old), wxWindow:refresh(Panel), + erlang:send_after(1000 div ?DISP_FREQ, self(), {refresh, 0}), {noreply, State#state{active=true}} catch _:_ -> - catch Old ! exit, - Me = self(), - Pid = spawn_link(Node, observer_backend, fetch_stats, [Me, 1000]), - wxWindow:refresh(Panel), - {noreply, State#state{active=true, appmon=Pid, data={0, queue:new()}}} + {noreply,restart_fetcher(Node, State)} end; handle_info(not_active, State = #state{appmon=_Pid}) -> @@ -237,173 +233,337 @@ terminate(_Event, #state{appmon=Pid}) -> code_change(_, _, State) -> State. -add_data(Stats, {N, Q}) when N > 60 -> - {N, queue:drop(queue:in(Stats, Q))}; -add_data(Stats, {N, Q}) -> - {N+1, queue:in(Stats, Q)}. +restart_fetcher(Node, #state{appmon=Old, panel=Panel, time=#ti{fetch=Freq}=Ti}=State) -> + catch Old ! exit, + Me = self(), + Pid = spawn_link(Node, observer_backend, fetch_stats, [Me, round(1000/Freq)]), + wxWindow:refresh(Panel), + precalc(State#state{active=true, appmon=Pid, samples=reset_data(), time=Ti#ti{tick=0}}). + +reset_data() -> + {0, queue:new()}. + +add_data(Stats, {N, Q0}, Wins, #ti{fetch=Fetch, secs=Secs}, Active) when N > (Secs*Fetch+1) -> + {{value, Drop}, Q} = queue:out(Q0), + add_data_1(Wins, Stats, N, {Drop,Q}, Active); +add_data(Stats, {N, Q}, Wins, _, Active) -> + add_data_1(Wins, Stats, N+1, {empty, Q}, Active). + +add_data_1([#win{state={_,St}}|_]=Wins0, Last, N, {Drop, Q}, Active) + when St /= undefined -> + {Wins, Stat} = + lists:mapfoldl(fun(Win0, Entry) -> + {Win1,Stat} = add_data_2(Win0, Last, Entry), + case Active of + true -> + Win = add_data_3(Win1, N, Drop, Stat, Q), + {Win, Stat}; + false -> + {Win1, Stat} + end + end, #{}, Wins0), + {Wins, {N,queue:in(Stat#{}, Q)}}; +add_data_1(Wins, Stats, 1, {_, Q}, _) -> + {[Win#win{state=init_data(Id, Stats), + info = info(Id, Stats)} + || #win{name=Id}=Win <- Wins], {0,Q}}. + +add_data_2(#win{name=Id, state=S0}=Win, Stats, Map) -> + {V1, S1} = collect_data(Id, Stats, S0), + {Win#win{state=S1}, Map#{Id=>V1}}. + +add_data_3(#win{name=Id, max={{OldMax, OldEntry},_,_,_}, + geom=#{scale:={WS,HS}}, state={Max,_}, + graphs=Graphs}=Win, + N, Drop0, Last, Q1) + when N > 3 -> + Drop = case Drop0 of + #{Id:=D} -> D; + _ -> Drop0 + end, + case {max_value(Max), Drop =:= OldEntry} of + {OldMax, false} -> + #{Id:=V4} = Last, + {{value, #{Id:=V3}},Q2} = queue:out_r(Q1), + {{value, #{Id:=V2}},Q3} = queue:out_r(Q2), + {{value, #{Id:=V1}},_} = queue:out_r(Q3), + Vals = [V1,V2,V3,V4], + Gs = tuple_size(V1), + Info = lists:zip(lists:seq(Gs, 1, -1), Graphs), + Lines = [add_lines(Vals, Drop, Prev, I, WS, HS) || {I, Prev} <- Info], + Win#win{graphs=Lines, no_samples=N}; + _W -> %% Max changed Trigger complete recalc + Win#win{max=undefined} + end; +add_data_3(Win, _, _, _,_) -> + %% Trigger complete recalc + Win#win{max=undefined}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% create_menus(Parent, _) -> - MenuEntries = - [{"File", - [ - ]} - ], - observer_wx:create_menus(Parent, MenuEntries). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -collect_data(runq, {N, Q}) -> - case queue:to_list(Q) of - [] -> {0, 0, [], []}; - [_] -> {0, 0, [], []}; - [{stats, _Ver, Init0, _IO, _Mem}|Data0] -> - Init = lists:sort(Init0), - [_|Data=[First|_]] = lists:foldl(fun({stats, _, T0, _, _}, [Prev|Acc]) -> - TN = lists:sort(T0), - Delta = calc_delta(TN, Prev), - [TN, list_to_tuple(Delta)|Acc] - end, [Init], Data0), - NoGraphs = tuple_size(First), - {N, lmax(Data), lists:reverse([First|Data]), lists:seq(1, NoGraphs)} - end; -collect_data(memory, {N, Q}) -> - MemT = mem_types(), - Data = [list_to_tuple([Value || {Type,Value} <- MemInfo, - lists:member(Type, MemT)]) - || {stats, _Ver, _RQ, _IO, MemInfo} <- queue:to_list(Q)], - {N, lmax(Data), Data, MemT}; -collect_data(io, {N, Q}) -> - case queue:to_list(Q) of - [] -> {0, 0, [], []}; - [_] -> {0, 0, [], []}; - [{stats, _Ver, _RQ, {{_,In0}, {_,Out0}}, _Mem}|Data0] -> - [_,_|Data=[First|_]] = - lists:foldl(fun({stats, _, _, {{_,In}, {_,Out}}, _}, [PIn,Pout|Acc]) -> - [In,Out,{In-PIn,Out-Pout}|Acc] - end, [In0,Out0], Data0), - {N, lmax(Data), lists:reverse([First|Data]), [input, output]} - end; -collect_data(alloc, {N, Q}) -> - List = queue:to_list(Q), - Data = [list_to_tuple([Carrier || {_Type,_Block,Carrier} <- MemInfo]) - || MemInfo <- List], - Info = case List of %% Varies depending on erlang build config/platform - [MInfo|_] -> [Type || {Type, _, _} <- MInfo]; - _ -> [] - end, - {N, lmax(Data), Data, Info}; - -collect_data(utilz, {N, Q}) -> - List = queue:to_list(Q), - Data = [list_to_tuple([round(100*Block/Carrier) || {_Type,Block,Carrier} <- MemInfo]) - || MemInfo <- List], - Info = case List of %% Varies depending on erlang build config/platform - [MInfo|_] -> [Type || {Type, _, _} <- MInfo]; - _ -> [] - end, - {N, lmax(Data), Data, Info}. + View = {"View", [#create_menu{id = ?ID_REFRESH_INTERVAL, text = "Graph Settings"}]}, + observer_wx:create_menus(Parent, [{"File", []}, View]). + +interval_dialog(Parent0, #ti{fetch=Fetch0, secs=Secs0}=Ti) -> + Parent = observer_lib:get_wx_parent(Parent0), + Dialog = wxDialog:new(Parent, ?wxID_ANY, "Load Chart Settings", + [{style, ?wxDEFAULT_DIALOG_STYLE bor + ?wxRESIZE_BORDER}]), + {Sl1,FetchSl} = slider(Dialog, "Sample (ms)", trunc(1000 / Fetch0), 100, 10000), + {Sl2, SecsSl} = slider(Dialog, "Length (min)", Secs0 div 60, 1, 10), + TopSizer = wxBoxSizer:new(?wxVERTICAL), + Flags = [{flag, ?wxEXPAND bor ?wxTOP bor ?wxLEFT bor ?wxRIGHT}, + {border, 5}, {proportion, 1}], + wxSizer:add(TopSizer, Sl1, Flags), + wxSizer:add(TopSizer, Sl2, Flags), + wxSizer:add(TopSizer, wxDialog:createButtonSizer(Dialog, ?wxOK bor ?wxCANCEL), Flags), + wxWindow:setSizerAndFit(Dialog, TopSizer), + wxSizer:setSizeHints(TopSizer, Dialog), + Res = case wxDialog:showModal(Dialog) of + ?wxID_OK -> + Fetch = 1000 / wxSlider:getValue(FetchSl), + Secs = wxSlider:getValue(SecsSl) * 60, + Ti#ti{fetch=Fetch, secs=Secs, disp=?DISP_FREQ/Fetch}; + ?wxID_CANCEL -> + Ti + end, + wxDialog:destroy(Dialog), + Res. + +slider(Parent, Str, Value, Min, Max) -> + Sz = wxBoxSizer:new(?wxHORIZONTAL), + Center = [{flag, ?wxALIGN_CENTER_VERTICAL}], + wxSizer:add(Sz, wxStaticText:new(Parent, ?wxID_ANY, Str), [{proportion, 1}|Center]), + Opt = [{style, ?wxSL_HORIZONTAL bor ?wxSL_LABELS}], + Slider = wxSlider:new(Parent, ?wxID_ANY, Value, Min, Max, Opt), + wxSizer:add(Sz, Slider, [{proportion, 2}|Center]), + case Min > 1 of + false -> + {Sz, Slider}; + true -> + CB = fun(#wx{event=Ev},_) -> step(Ev, Slider, Min) end, + wxSlider:connect(Slider, scroll_thumbtrack, [{callback, CB}]), + wxSlider:connect(Slider, scroll_changed, [{callback, CB}]), + {Sz, Slider} + end. +step(_Ev = #wxScroll{commandInt=Value}, Slider, Min) -> + Val = Min * round(Value / Min), + wxSlider:setValue(Slider, Val), + ok. -mem_types() -> - [total, processes, atom, binary, code, ets]. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -lmax([]) -> 0; -lmax(List) -> - Max = [lists:max(tuple_to_list(T)) || T <- List, - tuple_size(T) > 0], - case Max of - [] -> 0; - _ -> lists:max(Max) +mk_max() -> {0, undefined}. +max_value({Max,_}) -> Max. +%% max_data({_,Data}) -> Data. matched in function head + +lmax(MState, Tuple, Tuple) when is_tuple(Tuple) -> + lmax(MState, tuple_to_list(Tuple), Tuple); +lmax(MState, Values, State) -> + Max = max_value(MState), + New = lists:max([Max|Values]), + case New >= Max of + false -> MState; + true -> {New, State} end. +init_data(runq, {stats, _, T0, _, _}) -> {mk_max(),lists:sort(T0)}; +init_data(io, {stats, _, _, {{_,In0}, {_,Out0}}, _}) -> {mk_max(), {In0,Out0}}; +init_data(memory, _) -> {mk_max(), info(memory, undefined)}; +init_data(alloc, _) -> {mk_max(), ok}; +init_data(utilz, _) -> {mk_max(), ok}. + +info(runq, {stats, _, T0, _, _}) -> lists:seq(1, length(T0)); +info(memory, _) -> [total, processes, atom, binary, code, ets]; +info(io, _) -> [input, output]; +info(alloc, First) -> [Type || {Type, _, _} <- First]; +info(utilz, First) -> [Type || {Type, _, _} <- First]; +info(_, []) -> []. + +collect_data(runq, {stats, _, T0, _, _}, {Max,S0}) -> + S1 = lists:sort(T0), + Delta = calc_delta(S1, S0), + Sample = list_to_tuple(Delta), + {Sample, {lmax(Max,Delta,Sample), S1}}; +collect_data(io, {stats, _, _, {{_,In0}, {_,Out0}}, _}, {Max,{PIn,POut}}) -> + In = In0-PIn, + Out = Out0-POut, + Sample = {In, Out}, + {Sample, {lmax(Max, [In,Out], Sample), {In0, Out0}}}; +collect_data(memory, {stats, _, _, _, MemInfo}, {Max, MemTypes}) -> + Vs = [Value || {Type,Value} <- MemInfo, lists:member(Type, MemTypes)], + Sample = list_to_tuple(Vs), + {Sample, {lmax(Max, Vs, Sample),MemTypes}}; +collect_data(alloc, MemInfo, Max) -> + Vs = [Carrier || {_Type,_Block,Carrier} <- MemInfo], + Sample = list_to_tuple(Vs), + {Sample, lmax(Max, Vs, Sample)}; +collect_data(utilz, MemInfo, Max) -> + Vs = [round(100*Block/Carrier) || {_Type,Block,Carrier} <- MemInfo], + Sample = list_to_tuple(Vs), + {Sample, lmax(Max,Vs,Sample)}. + calc_delta([{Id, WN, TN}|Ss], [{Id, WP, TP}|Ps]) -> [100*(WN-WP) div (TN-TP)|calc_delta(Ss, Ps)]; calc_delta([], []) -> []. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -draw(Offset, Id, DC, Panel, Paint=#paint{pens=Pens, small=Small}, Data, Active) -> - %% This can be optimized a lot by collecting data once - %% and draw to memory and then blit memory and only draw new entries in new memory - %% area. Hmm now rewritten to use ?wxGC I don't now if it is feasable. - {Len, Max0, Hs, Info} = collect_data(Id, Data), - {Max,_,_} = MaxDisp = calc_max(Id, Max0), +precalc(#state{samples=Data0, paint=Paint, time=Ti, wins=Wins0}=State) -> + Wins = [precalc(Ti, Data0, Paint, Win) || Win <- Wins0], + State#state{wins=Wins}. + +precalc(Ti, {NoSamples,Q}, Paint, #win{name=Id, panel=Panel}=Win) -> Size = wxWindow:getClientSize(Panel), - {X0,Y0,WS,HS, DrawBs} = draw_borders(Id, Info, DC, Size, MaxDisp, Paint), - Last = 60*WS+X0-1, - Start = max(61-Len, 0)*WS+X0 - Offset*WS, - Samples = length(Hs), - NoGraphs = try tuple_size(hd(Hs)) catch _:_ -> 0 end, - case Active andalso Samples > 1 andalso NoGraphs > 0 of - true -> - Draw = fun(N) -> - Lines = make_lines(Hs, Start, N, {X0,Max*HS,Last}, Y0, WS, HS), - setPen(DC, element(1+ ((N-1) rem tuple_size(Pens)), Pens)), - strokeLines(DC, Lines), - N+1 - end, - [Draw(I) || I <- lists:seq(NoGraphs, 1, -1)], - DrawBs(); - false -> - DrawBs(), - Text = case Active andalso Samples =< 1 of + case Win of + #win{max=Max, no_samples=NoSamples, size=Size} when is_tuple(Max) -> + Win; + _SomeThingChanged -> + Hs = [Vals || #{Id:=Vals} <- queue:to_list(Q)], + Max = lists:foldl(fun(Vals,Max) -> lmax(Max, Vals, Vals) end, + mk_max(), Hs), + MaxDisp = calc_max(Id, Max), + #{scale:={WS,HS}} = Props = window_geom(Size, MaxDisp, Ti, Panel, Paint), + NoGraphs = try tuple_size(hd(Hs)) catch _:_ -> 0 end, + Graphs = [make_lines(Hs, I, WS, HS) || I <- lists:seq(NoGraphs, 1, -1)], + State = case Win#win.state of + undefined -> {Max, undefined}; + {_, St} -> {Max, St} + end, + Win#win{geom=Props, size=Size, + max=MaxDisp, + graphs=Graphs, + no_samples=NoSamples, + state=State} + end. + +window_geom({W,H}, {_, Max, _Unit, MaxUnit}, + #ti{secs=Secs, fetch=FetchFreq}, + Panel, #paint{font=Font}) -> + Str1 = observer_lib:to_str(MaxUnit), + Str2 = observer_lib:to_str(MaxUnit div 2), + Str3 = observer_lib:to_str(0), + {TW,TH,_,_} = wxWindow:getTextExtent(Panel, Str1, [{theFont, Font}]), + {SpaceW, _,_,_} = wxWindow:getTextExtent(Panel, "W", [{theFont, Font}]), + X0 = ?BW+TW+?BW, + X1 = W-?BW*4, + MaxTextY = TH+?BH, + BottomTextY = H-?BH-TH, + Y0 = MaxTextY + (TH / 2), + Y1 = BottomTextY - TH - ?BH, + + ScaleW = (X1-X0-1)/(Secs*FetchFreq), + ScaleH = (Y1-Y0-1) / Max, + #{p0=>{X0,Y0}, p1=>{X1,Y1}, scale=>{ScaleW, ScaleH}, + txsz=>{TW,TH,SpaceW}, txt=>{BottomTextY, MaxTextY}, strs=>{Str1,Str2,Str3}}. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +draw_win(DC, #win{no_samples=Samples, geom=#{scale:={WS,HS}}, graphs=Graphs, max={_,Max,_,_}}=Win, + #ti{tick=Tick, fetch=FetchFreq, secs=Secs, disp=DispFreq}=Ti, + Paint=#paint{pens=Pens}) when Samples >= 2, Graphs =/= [] -> + %% Draw graphs + {X0,Y0,DrawBs} = draw_borders(DC, Ti, Win, Paint), + Offset = Tick / DispFreq, + Full = case Samples > (1+Secs*FetchFreq) of + true -> 1; + false -> 2 + end, + Start = X0 + (max(Secs*FetchFreq+Full-Samples, 0) - Offset)*WS, + Last = Secs*FetchFreq*WS+X0, + Draw = fun(Lines0, N) -> + setPen(DC, element(1+ ((N-1) rem tuple_size(Pens)), Pens)), + Order = lists:reverse(Lines0), + [{_,Y}|Lines] = translate(Order, {Start, Y0}, 0, WS, {X0,Max*HS,Last}, []), + strokeLines(DC, [{Last,Y}|Lines]), + N-1 + end, + lists:foldl(Draw, length(Graphs), Graphs), + DrawBs(), + ok; + +draw_win(DC, #win{no_samples=Samples} = Win,Ti, #paint{small=Small}=Paint) -> + %% Draw Error Msg + try draw_borders(DC, Ti, Win, Paint) of + {X0,_Y0,DrawBs} -> + Text = case Samples =< 1 of true -> "Waiting for data"; false -> "Information not available" end, setFont(DC, Small, {0,0,0}), - drawText(DC, Text, X0 + 100, element(2,Size) div 2) - end, - ok. + {_,WW} = getSize(DC), + drawText(DC, Text, X0 + 100, WW div 2), + DrawBs(), + ok + catch _:_ -> %% Early redraws fail + ok + end. -make_lines(Ds = [Data|_], PX, N, Clip, ZeroY, WS, HS) -> +translate([{X0,Y}|Rest], {Sx,Sy}=Start, N, WS, {Cx,Cy,Cw}=Clip, Acc) -> + X = min((N-X0)*WS+Sx,Cw), + Next = if X0 > 0 -> N; true -> N+1 end, + case X =< Cx of + true -> + translate(Rest, Start, Next, WS, Clip, [{Cx,Sy-min(Cy,Y)}]); + false -> + translate(Rest, Start, Next, WS, Clip, [{X,Sy-min(Cy,Y)}|Acc]) + end; +translate([], _, _, _, _, Acc) -> + Acc. + +add_lines(Vals, Drop, OldLines, I, WS, HS) -> + Lines = strip(OldLines, Drop, 2), + New = make_lines(Vals, I, WS, HS), + New ++ Lines. + +strip([{X,_}|Rest], Drop, N) when X > 0.0001, N > 0 -> + strip(Rest, Drop, N); +strip([_|Rest], Drop, N) when N > 0 -> + strip(Rest, Drop, N-1); +strip(List, empty, _) -> List; +strip(List, _, _) -> + lists:reverse(strip(lists:reverse(List), empty, 1)). + +make_lines(Ds = [Data|_], N, WS, HS) -> Y = element(N,Data), - make_lines(Ds, PX, N, Clip, ZeroY, WS, HS, Y, []). + make_lines(Ds, N, WS, HS, Y, []). -make_lines([D1 | Ds = [D2|Rest]], PX, N, Clip={Cx,Cy, _}, ZeroY, WS, HS, Y0, Acc0) -> +make_lines([D1 | Ds = [D2|Rest]], N, WS, HS, Y0, Acc0) -> Y1 = element(N,D1), Y2 = element(N,D2), Y3 = case Rest of [D3|_] -> element(N,D3); [] -> Y2 end, - This = {max(Cx, PX),ZeroY-min(Cy,Y1*HS)}, + This = {0, Y1*HS}, Acc = if (abs(Y1-Y2) * HS) < 3.0 -> [This|Acc0]; WS < 3.0 -> [This|Acc0]; - PX < Cx -> - make_splines(Y0,Y1,Y2,Y3,PX,Clip,ZeroY,WS,HS,Acc0); - true -> - make_splines(Y0,Y1,Y2,Y3,PX,Clip,ZeroY,WS,HS,[This|Acc0]) + true -> make_splines(Y0,Y1,Y2,Y3,WS,HS,[This|Acc0]) end, - make_lines(Ds, PX+WS, N, Clip, ZeroY, WS, HS, Y1, Acc); -make_lines([D1], _PX, N, {_,Cy,Last}, ZeroY, _WS, HS, _Y0, Acc) -> - Y1 = element(N,D1), - [{Last,ZeroY-min(Cy, Y1*HS)}|Acc]. + make_lines(Ds, N, WS, HS, Y1, Acc); +make_lines([_D1], _N, _WS, _HS, _Y0, Acc) -> + Acc. -make_splines(Y00,Y10,Y20,Y30,PX,Clip,ZeroY,WS,HS,Acc) -> +make_splines(Y00,Y10,Y20,Y30,WS,HS,Acc) -> Y1 = Y10*HS, Y2 = Y20*HS, - Steps = min(abs(Y1-Y2), WS), + Steps = min(abs(Y1-Y2), WS/2), if Steps > 2 -> Y0 = Y00*HS, Y3 = Y30*HS, Tan = spline_tan(Y0,Y1,Y2,Y3), Delta = 1/Steps, - splines(Steps-1, 0.0, Delta, Tan, Y1,Y2, PX, Clip,ZeroY, Delta*WS, Acc); + splines(Steps-1, 0.0, Delta, Tan, Y1,Y2, Acc); true -> Acc end. -splines(N, XD, XD0, Tan, Y1,Y2, PX0, Clip={Cx,Cy,_},ZeroY, WS, Acc) when N > 0 -> - PX = PX0+WS, +splines(N, XD, XD0, Tan, Y1,Y2, Acc) when N > 0 -> Delta = XD+XD0, - if PX < Cx -> - splines(N-1, Delta, XD0, Tan, Y1, Y2, PX, Clip,ZeroY, WS, Acc); - true -> - Y = min(Cy, max(0,spline(Delta, Tan, Y1,Y2))), - splines(N-1, Delta, XD0, Tan, Y1, Y2, PX, Clip,ZeroY, WS, - [{PX, ZeroY-Y}|Acc]) - end; -splines(_N, _XD, _XD0, _Tan, _Y1,_Y2, _PX, _Clip,_ZeroY, _WS, Acc) -> Acc. + Y = max(0, spline(Delta, Tan, Y1,Y2)), + splines(N-1, Delta, XD0, Tan, Y1, Y2, [{1.0-Delta, Y}|Acc]); +splines(_N, _XD, _XD0, _Tan, _Y1,_Y2, Acc) -> + Acc. spline(T, {M1, M2}, Y1, Y2) -> %% Hermite Basis Funcs @@ -423,34 +583,19 @@ spline_tan(Y0, Y1, Y2, Y3) -> M2 = S*C*(Y3-Y1), {M1,M2}. --define(BW, 5). --define(BH, 5). - -draw_borders(Type, Info, DC, {W,H}, {Max, Unit, MaxUnit}, +draw_borders(DC, #ti{secs=Secs, fetch=FetchFreq}, + #win{name=Type, geom=Geom, info=Info, max={_,_,Unit,_}}, #paint{pen=Pen, pen2=Pen2, font=Font, small=Small}) -> - Str1 = observer_lib:to_str(MaxUnit), - Str2 = observer_lib:to_str(MaxUnit div 2), - Str3 = observer_lib:to_str(0), - - setFont(DC, Font, {0,0,0}), - {TW,TH} = getTextExtent(DC, Str1), - {SpaceW, _} = getTextExtent(DC, "W"), + #{p0:={GraphX0, GraphY0}, p1:={GraphX1,GraphY1}, scale:={ScaleW0,_}, + txsz:={TW,TH,SpaceW}, txt:={BottomTextY, MaxTextY}, strs:={Str1,Str2,Str3}} = Geom, - GraphX0 = ?BW+TW+?BW, - GraphX1 = W-?BW*4, + ScaleW = ScaleW0*FetchFreq, TopTextX = ?BW*3+TW, - MaxTextY = TH+?BH, - BottomTextY = H-?BH-TH, SecondsY = BottomTextY - TH, - GraphY0 = MaxTextY + (TH / 2), - GraphY1 = SecondsY - ?BH, - GraphW = GraphX1-GraphX0-1, - GraphH = GraphY1-GraphY0-1, + GraphY25 = GraphY0 + (GraphY1 - GraphY0) / 4, GraphY50 = GraphY0 + (GraphY1 - GraphY0) / 2, GraphY75 = GraphY0 + 3*(GraphY1 - GraphY0) / 4, - ScaleW = GraphW / 60, - ScaleH = GraphH / Max, setFont(DC, Small, {0,0,0}), Align = fun(Str, Y) -> @@ -462,14 +607,21 @@ draw_borders(Type, Info, DC, {W,H}, {Max, Unit, MaxUnit}, Align(Str3, GraphY1 - (TH / 2) + 1), setPen(DC, Pen), - DrawSecs = fun(Secs, Pos) -> - Str = [observer_lib:to_str(Secs)|" s"], + DrawSecs = fun(Sec, {Pos, Prev}) -> + Str = observer_lib:to_str(Sec) ++ "s", X = GraphX0+Pos, - drawText(DC, Str, X-SpaceW, SecondsY), strokeLine(DC, X, GraphY0, X, GraphY1+5), - Pos + 10*ScaleW + TxtX = X-SpaceW, + case TxtX > Prev of + true -> + drawText(DC, Str, TxtX, SecondsY), + TxtW = SpaceW*length(Str), + {Pos + 10*ScaleW, TxtX+TxtW}; + false -> + {Pos + 10*ScaleW, Prev} + end end, - lists:foldl(DrawSecs, 0, lists:seq(60,0, -10)), + lists:foldl(DrawSecs, {0, 0}, lists:seq(Secs,0, -10)), strokeLine(DC, GraphX0-3, GraphY25, GraphX1, GraphY25), strokeLine(DC, GraphX0-3, GraphY50, GraphX1, GraphY50), @@ -526,7 +678,7 @@ draw_borders(Type, Info, DC, {W,H}, {Max, Unit, MaxUnit}, {GraphX1, GraphY1+1}, {GraphX1, GraphY0-1}, {GraphX0, GraphY0-1}]) end, - {GraphX0+1, GraphY1, ScaleW, ScaleH, DrawBorder}. + {GraphX0+1, GraphY1, DrawBorder}. to_string(Atom) -> Name = atom_to_list(Atom), @@ -543,43 +695,44 @@ uppercase([C|Rest]) -> calc_max(Type, Max) -> bytes(Type, Max). -calc_max1(Max) when Max < 10 -> - 10; -calc_max1(Max) -> - case Max div 10 of - X when X < 10 -> - case Max rem 10 of - 0 -> Max; - _ -> - (X+1)*10 - end; - X -> - 10*calc_max1(X) - end. - -bytes(runq, Val) -> - Upper = calc_max1(Val), - {Upper, "", Upper}; -bytes(utilz, Val) -> - Upper = calc_max1(Val), - {Upper, "", Upper}; -bytes(_, B) -> +bytes(runq, Max) -> + Upper = calc_max1(max_value(Max)), + {Max, Upper, "", Upper}; +bytes(utilz, Max) -> + Upper = calc_max1(max_value(Max)), + {Max, Upper, "", Upper}; +bytes(_, Max) -> + B = max_value(Max), KB = B div 1024, MB = KB div 1024, GB = MB div 1024, if GB > 10 -> Upper = calc_max1(GB), - {Upper*1024*1024*1024, "(GB)", Upper}; + {Max, Upper*1024*1024*1024, "(GB)", Upper}; MB > 10 -> Upper = calc_max1(MB), - {Upper*1024*1024, "(MB)", Upper}; + {Max, Upper*1024*1024, "(MB)", Upper}; KB > 0 -> Upper = calc_max1(KB), - {Upper*1024, "(KB)", Upper}; + {Max, Upper*1024, "(KB)", Upper}; true -> Upper = calc_max1(B), - {Upper, "(B)", Upper} + {Max, Upper, "(B)", Upper} + end. + +calc_max1(Max) when Max < 10 -> + 10; +calc_max1(Max) -> + case Max div 10 of + X when X < 10 -> + case Max rem 10 of + 0 -> Max; + _ -> + (X+1)*10 + end; + X -> + 10*calc_max1(X) end. colors() -> @@ -592,6 +745,25 @@ colors() -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% wxDC and ?wxGC wrappers +make_gc(Panel,UseGC) -> + DC = case os:type() of + {win32, _} -> + %% Ugly hack to avoid flickering on windows, works on windows only + %% But the other platforms are doublebuffered by default + DC0 = wx:typeCast(wxBufferedPaintDC:new(Panel), wxPaintDC), + wxDC:clear(DC0), + DC0; + _ -> + wxPaintDC:new(Panel) + end, + if UseGC -> {?wxGC:create(DC), DC}; + true -> {false, DC} + end. + +destroy_gc({GC, DC}) -> + (GC =/= false) andalso ?wxGC:destroy(GC), + wxPaintDC:destroy(DC). + haveGC() -> try wxGraphicsRenderer:getDefaultRenderer(), @@ -599,44 +771,48 @@ haveGC() -> catch _:_ -> false end. +getSize({_, DC}) -> + wxDC:getSize(DC). + setPen({false, DC}, Pen) -> wxDC:setPen(DC, Pen); -setPen({true, GC}, Pen) -> +setPen({GC, _}, Pen) -> ?wxGC:setPen(GC, Pen). setFont({false, DC}, Font, Color) -> wxDC:setTextForeground(DC, Color), wxDC:setFont(DC, Font); -setFont({true, GC}, Font, Color) -> +setFont({GC, _}, Font, Color) -> ?wxGC:setFont(GC, Font, Color). setBrush({false, DC}, Brush) -> wxDC:setBrush(DC, Brush); -setBrush({true, GC}, Brush) -> +setBrush({GC, _}, Brush) -> ?wxGC:setBrush(GC, Brush). strokeLine({false, DC}, X0, Y0, X1, Y1) -> wxDC:drawLine(DC, {round(X0), round(Y0)}, {round(X1), round(Y1)}); -strokeLine({true, GC}, X0, Y0, X1, Y1) -> +strokeLine({GC, _}, X0, Y0, X1, Y1) -> ?wxGC:strokeLine(GC, X0, Y0, X1, Y1). +strokeLines(_, [_]) -> ok; strokeLines({false, DC}, Lines) -> wxDC:drawLines(DC, [{round(X), round(Y)} || {X,Y} <- Lines]); -strokeLines({true, GC}, Lines) -> +strokeLines({GC, _}, Lines) -> ?wxGC:strokeLines(GC, Lines). drawRoundedRectangle({false, DC}, X0, Y0, X1, Y1, R) -> wxDC:drawRoundedRectangle(DC, {round(X0), round(Y0)}, {round(X1), round(Y1)}, round(R)); -drawRoundedRectangle({true, GC}, X0, Y0, X1, Y1, R) -> +drawRoundedRectangle({GC, _}, X0, Y0, X1, Y1, R) -> ?wxGC:drawRoundedRectangle(GC, X0, Y0, X1, Y1, R). drawText({false, DC}, Str, X, Y) -> wxDC:drawText(DC, Str, {round(X),round(Y)}); -drawText({true, GC}, Str, X, Y) -> +drawText({GC, _}, Str, X, Y) -> ?wxGC:drawText(GC, Str, X, Y). getTextExtent({false, DC}, Str) -> wxDC:getTextExtent(DC, Str); -getTextExtent({true, GC}, Str) -> +getTextExtent({GC, _}, Str) -> {W,H,_,_} = ?wxGC:getTextExtent(GC, Str), {W,H}. diff --git a/lib/observer/src/observer_traceoptions_wx.erl b/lib/observer/src/observer_traceoptions_wx.erl index 56ac96a91f..9ba9b72b6f 100644 --- a/lib/observer/src/observer_traceoptions_wx.erl +++ b/lib/observer/src/observer_traceoptions_wx.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011-2012. All Rights Reserved. +%% Copyright Ericsson AB 2011-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. @@ -665,7 +665,7 @@ get_file(Text) -> Str = wxTextCtrl:getValue(Text), Dialog = wxFileDialog:new(Text, [{message, "Select a file"}, - {default_file, Str}]), + {defaultFile, Str}]), case wxDialog:showModal(Dialog) of ?wxID_OK -> Dir = wxFileDialog:getDirectory(Dialog), diff --git a/lib/observer/src/observer_tv_table.erl b/lib/observer/src/observer_tv_table.erl index 88f606b3e4..75e6919642 100644 --- a/lib/observer/src/observer_tv_table.erl +++ b/lib/observer/src/observer_tv_table.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011-2014. All Rights Reserved. +%% Copyright Ericsson AB 2011-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. @@ -669,6 +669,7 @@ merge([], New, _Key) -> merge(Old, New, Key) -> merge2(keysort(Key, Old), keysort(Key, New), Key). +-dialyzer({no_improper_lists, merge2/3}). merge2([[Obj|_]|Old], [Obj|New], Key) -> [[Obj]|merge2(Old, New, Key)]; merge2([[A|Op]|Old], [B|New], Key) diff --git a/lib/observer/test/Makefile b/lib/observer/test/Makefile index e8bb7d0a52..6100af5e17 100644 --- a/lib/observer/test/Makefile +++ b/lib/observer/test/Makefile @@ -45,8 +45,8 @@ RELSYSDIR = $(RELEASE_PATH)/observer_test # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- -ERL_MAKE_FLAGS += -pa $(ERL_TOP)/lib/test_server/ebin -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +ERL_MAKE_FLAGS += +ERL_COMPILE_FLAGS += EBIN = . @@ -60,8 +60,6 @@ make_emakefile: $(MODULES) > $(EMAKEFILE) tests debug opt: make_emakefile - cd $(ERL_TOP)/lib/test_server/src && \ - $(MAKE) ../ebin/test_server_line.beam erl $(ERL_MAKE_FLAGS) -make clean: diff --git a/lib/observer/test/crashdump_helper.erl b/lib/observer/test/crashdump_helper.erl index eea82d8c3c..e9a3ba0369 100644 --- a/lib/observer/test/crashdump_helper.erl +++ b/lib/observer/test/crashdump_helper.erl @@ -21,7 +21,7 @@ -module(crashdump_helper). -export([n1_proc/2,remote_proc/2]). -compile(r13). --include("test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). n1_proc(N2,Creator) -> spawn(fun() -> n1_proc(Creator,N2,x,y,[]) end). diff --git a/lib/observer/test/crashdump_viewer_SUITE.erl b/lib/observer/test/crashdump_viewer_SUITE.erl index 84af440245..2d47054600 100644 --- a/lib/observer/test/crashdump_viewer_SUITE.erl +++ b/lib/observer/test/crashdump_viewer_SUITE.erl @@ -30,7 +30,6 @@ -export([init_per_testcase/2, end_per_testcase/2]). -include_lib("common_test/include/ct.hrl"). --include("test_server_line.hrl"). -include_lib("kernel/include/file.hrl"). -define(failed_file,"failed-cases.txt"). diff --git a/lib/observer/test/etop_SUITE.erl b/lib/observer/test/etop_SUITE.erl index d4857c5e2f..4b05e4c2a0 100644 --- a/lib/observer/test/etop_SUITE.erl +++ b/lib/observer/test/etop_SUITE.erl @@ -26,7 +26,7 @@ -export([text/1,text/2,text_tracing_off/1,text_tracing_off/2]). -export([init_per_testcase/2, end_per_testcase/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(default_timeout, ?t:minutes(1)). diff --git a/lib/observer/test/observer_SUITE.erl b/lib/observer/test/observer_SUITE.erl index 7f96d72e59..a33df61b98 100644 --- a/lib/observer/test/observer_SUITE.erl +++ b/lib/observer/test/observer_SUITE.erl @@ -19,7 +19,7 @@ %% -module(observer_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("wx/include/wx.hrl"). -include_lib("observer/src/observer_tv.hrl"). diff --git a/lib/observer/test/ttb_SUITE.erl b/lib/observer/test/ttb_SUITE.erl index bdf10f507d..f1649e6cb9 100644 --- a/lib/observer/test/ttb_SUITE.erl +++ b/lib/observer/test/ttb_SUITE.erl @@ -32,7 +32,7 @@ -export([init_per_testcase/2, end_per_testcase/2]). -export([foo/0]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(default_timeout, ?t:minutes(1)). -define(OUTPUT, "handler_output"). diff --git a/lib/odbc/test/Makefile b/lib/odbc/test/Makefile index 114eb5373d..4fecea3aae 100644 --- a/lib/odbc/test/Makefile +++ b/lib/odbc/test/Makefile @@ -21,7 +21,7 @@ include $(ERL_TOP)/make/target.mk include $(ERL_TOP)/make/$(TARGET)/otp.mk -INCLUDES= -I. -I$(ERL_TOP)/lib/test_server/include/ -I$(ERL_TOP)/lib/odbc/src +INCLUDES= -I. -I$(ERL_TOP)/lib/odbc/src # ---------------------------------------------------- # Target Specs diff --git a/lib/odbc/test/odbc_connect_SUITE.erl b/lib/odbc/test/odbc_connect_SUITE.erl index 2d4173a008..41601a2750 100644 --- a/lib/odbc/test/odbc_connect_SUITE.erl +++ b/lib/odbc/test/odbc_connect_SUITE.erl @@ -26,7 +26,6 @@ -compile(export_all). -include_lib("common_test/include/ct.hrl"). --include("test_server_line.hrl"). -include("odbc_test.hrl"). -define(MAX_SEQ_TIMEOUTS, 10). diff --git a/lib/odbc/test/odbc_data_type_SUITE.erl b/lib/odbc/test/odbc_data_type_SUITE.erl index a56af650c2..25988bef2a 100644 --- a/lib/odbc/test/odbc_data_type_SUITE.erl +++ b/lib/odbc/test/odbc_data_type_SUITE.erl @@ -27,7 +27,6 @@ -include_lib("common_test/include/ct.hrl"). -include_lib("stdlib/include/ms_transform.hrl"). --include("test_server_line.hrl"). -include("odbc_test.hrl"). %%-------------------------------------------------------------------- diff --git a/lib/odbc/test/odbc_query_SUITE.erl b/lib/odbc/test/odbc_query_SUITE.erl index e8c2df7c31..79c756e956 100644 --- a/lib/odbc/test/odbc_query_SUITE.erl +++ b/lib/odbc/test/odbc_query_SUITE.erl @@ -26,7 +26,6 @@ -compile(export_all). -include_lib("common_test/include/ct.hrl"). --include("test_server_line.hrl"). -include("odbc_test.hrl"). %%-------------------------------------------------------------------- diff --git a/lib/odbc/test/odbc_start_SUITE.erl b/lib/odbc/test/odbc_start_SUITE.erl index 8fb564d1f9..e16b4cfb7f 100644 --- a/lib/odbc/test/odbc_start_SUITE.erl +++ b/lib/odbc/test/odbc_start_SUITE.erl @@ -26,7 +26,6 @@ -compile(export_all). -include_lib("common_test/include/ct.hrl"). --include("test_server_line.hrl"). -include("odbc_test.hrl"). %% Test server callback functions diff --git a/lib/odbc/test/odbc_test_lib.erl b/lib/odbc/test/odbc_test_lib.erl index 6f49c019e3..88d772467c 100644 --- a/lib/odbc/test/odbc_test_lib.erl +++ b/lib/odbc/test/odbc_test_lib.erl @@ -26,7 +26,7 @@ -compile(export_all). -include("odbc_test.hrl"). --include("test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). unique_table_name() -> lists:reverse(lists:foldl(fun($@, Acc) -> [$t, $A |Acc] ; diff --git a/lib/orber/src/orber_ifr.erl b/lib/orber/src/orber_ifr.erl index cc23d9e242..70e0cb3fca 100644 --- a/lib/orber/src/orber_ifr.erl +++ b/lib/orber/src/orber_ifr.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% 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. @@ -780,6 +780,7 @@ find_repository() -> 'Repository__get_def_kind'(Objref) -> orber_ifr_repository:'_get_def_kind'(Objref). +-spec 'Repository_destroy'(_) -> no_return(). 'Repository_destroy'(Objref) -> orber_ifr_repository:destroy(Objref). 'Repository_lookup'(Objref,Search_name) -> @@ -1405,6 +1406,7 @@ find_repository() -> orber_ifr_orb:create_wstring_tc(Bound). 'ORB_create_sequence_tc'(Bound,Element_type) -> orber_ifr_orb:create_sequence_tc(Bound,Element_type). +-spec 'ORB_create_recursive_sequence_tc'(_,_) -> no_return(). 'ORB_create_recursive_sequence_tc'(Bound,Offset) -> orber_ifr_orb:create_recursive_sequence_tc(Bound,Offset). 'ORB_create_array_tc'(Length,Element_type) -> diff --git a/lib/orber/src/orber_ifr_orb.erl b/lib/orber/src/orber_ifr_orb.erl index a408a9a749..3969bbf37a 100644 --- a/lib/orber/src/orber_ifr_orb.erl +++ b/lib/orber/src/orber_ifr_orb.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% 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. @@ -89,6 +89,7 @@ create_wstring_tc(Bound) -> create_sequence_tc(Bound, Element_type) -> {tk_sequence,Element_type,Bound}. +-spec create_recursive_sequence_tc(_, _) -> no_return(). create_recursive_sequence_tc(Bound, Offset) -> orber:dbg("[~p] ~p:create_recursive_sequence_tc(~p, ~p);~n" "Create_recursive_sequence is not implemented.~n", diff --git a/lib/orber/src/orber_ifr_repository.erl b/lib/orber/src/orber_ifr_repository.erl index 898fba99f3..8d52573e53 100644 --- a/lib/orber/src/orber_ifr_repository.erl +++ b/lib/orber/src/orber_ifr_repository.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% 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. @@ -66,6 +66,7 @@ '_get_def_kind'({ObjType, ObjID}) ?tcheck(ir_Repository, ObjType) -> orber_ifr_irobject:'_get_def_kind'({ObjType, ObjID}). +-spec destroy(_) -> no_return(). destroy({ObjType, ObjID}) ?tcheck(ir_Repository, ObjType) -> orber:dbg("[~p] ~p:destroy(~p, ~p);~n" "Destroying a repository is an error.~n", diff --git a/lib/orber/src/orber_iiop.erl b/lib/orber/src/orber_iiop.erl index d23cd74146..8cb39c7365 100644 --- a/lib/orber/src/orber_iiop.erl +++ b/lib/orber/src/orber_iiop.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% 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. @@ -176,7 +176,7 @@ request({Host, Port, InitObjkey, Index, TaggedProfile, HostData}, corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO}) end. - +-dialyzer({no_improper_lists, encode_request/1}). encode_request(#giop_env{interceptors = false} = Env) -> case catch cdr_encode:enc_request(Env) of {'EXCEPTION', Exc} -> diff --git a/lib/orber/src/orber_iiop_inrequest.erl b/lib/orber/src/orber_iiop_inrequest.erl index 625bfd3e86..9d84b63398 100644 --- a/lib/orber/src/orber_iiop_inrequest.erl +++ b/lib/orber/src/orber_iiop_inrequest.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. 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. @@ -240,6 +240,7 @@ check_context([_|Rest], Acc, Env) -> %%----------------------------------------------------------------- %% Func: call_interceptors %%----------------------------------------------------------------- +-dialyzer({no_improper_lists, call_interceptors/7}). call_interceptors(SocketType, #giop_env{interceptors = {native, Ref, PIs}, ctx = Ctx} = Env, ReqHdr, Rest, Len, ByteOrder, Msg) -> @@ -276,6 +277,7 @@ call_interceptors(SocketType, #giop_env{interceptors = {portable, _PIs}} = Env, %%----------------------------------------------------------------- %% Func: call_interceptors_out %%----------------------------------------------------------------- +-dialyzer({no_improper_lists, call_interceptors_out/7}). call_interceptors_out(#giop_env{interceptors = {native, Ref, PIs}, ctx = Ctx} = Env, ReqId, Result, Obj, Type, Operation, TypeCodes) -> ReqHdr = #request_header{object_key = Obj, diff --git a/lib/orber/src/orber_pi.erl b/lib/orber/src/orber_pi.erl index 11c489bb17..19bb7af6c0 100644 --- a/lib/orber/src/orber_pi.erl +++ b/lib/orber/src/orber_pi.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2009. All Rights Reserved. +%% 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. @@ -1030,6 +1030,7 @@ receive_exception(CRI, Mod) -> %% SlotId - ulong() %% Returns : {'EXCEPTION', #'PortableInterceptor_InvalidSlot'{}} %%------------------------------------------------------------ +-spec get_slot(_, _) -> no_return(). get_slot(_XRI, _SlotId) -> corba:raise(#'PortableInterceptor_InvalidSlot'{}). @@ -1185,6 +1186,7 @@ get_server_policy(#'ServerRequestInfo'{contexts = Ctxs}, _PolicyType) -> %% Data - #any{} %% Returns : {'EXCEPTION', #'PortableInterceptor_InvalidSlot'{}} %%------------------------------------------------------------ +-spec set_slot(_, _, _) -> no_return(). set_slot(_SRI, _SlotId, _Data) -> corba:raise(#'PortableInterceptor_InvalidSlot'{}). diff --git a/lib/orber/test/Makefile b/lib/orber/test/Makefile index b9be48c790..1d4e3c70f0 100644 --- a/lib/orber/test/Makefile +++ b/lib/orber/test/Makefile @@ -162,12 +162,10 @@ TARGET_FILES = \ ERL_IDL_FLAGS += -pa $(ERL_TOP)/lib/orber/ebin -pa $(ERL_TOP)/lib/ic/ebin ERL_COMPILE_FLAGS += $(ERL_IDL_FLAGS) \ - -pa $(ERL_TOP)/lib/test_server/ebin \ -pa $(ERL_TOP)/lib/ic/ebin \ -pa $(ERL_TOP)/lib/orber/ebin \ -I$(ERL_TOP)/lib/orber \ - -I$(ERL_TOP)/lib/orber/test/$(IDLOUTDIR) \ - -I$(ERL_TOP)/lib/test_server/include + -I$(ERL_TOP)/lib/orber/test/$(IDLOUTDIR) # ---------------------------------------------------- # Targets diff --git a/lib/orber/test/cdrcoding_10_SUITE.erl b/lib/orber/test/cdrcoding_10_SUITE.erl index 1fec91dca3..dac6e78ddd 100644 --- a/lib/orber/test/cdrcoding_10_SUITE.erl +++ b/lib/orber/test/cdrcoding_10_SUITE.erl @@ -28,7 +28,7 @@ -include("idl_output/Module.hrl"). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -include_lib("orber/src/orber_iiop.hrl"). diff --git a/lib/orber/test/cdrcoding_11_SUITE.erl b/lib/orber/test/cdrcoding_11_SUITE.erl index 324b9b2b17..f4fe3d06e3 100644 --- a/lib/orber/test/cdrcoding_11_SUITE.erl +++ b/lib/orber/test/cdrcoding_11_SUITE.erl @@ -28,7 +28,7 @@ -include("idl_output/Module.hrl"). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -include_lib("orber/src/orber_iiop.hrl"). diff --git a/lib/orber/test/cdrcoding_12_SUITE.erl b/lib/orber/test/cdrcoding_12_SUITE.erl index f0a8fe4d7f..8843233d35 100644 --- a/lib/orber/test/cdrcoding_12_SUITE.erl +++ b/lib/orber/test/cdrcoding_12_SUITE.erl @@ -29,7 +29,7 @@ -module(cdrcoding_12_SUITE). -include("idl_output/Module.hrl"). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -include_lib("orber/src/orber_iiop.hrl"). diff --git a/lib/orber/test/cdrlib_SUITE.erl b/lib/orber/test/cdrlib_SUITE.erl index dd1f975d9e..8fc9c655ce 100644 --- a/lib/orber/test/cdrlib_SUITE.erl +++ b/lib/orber/test/cdrlib_SUITE.erl @@ -26,7 +26,7 @@ %%----------------------------------------------------------------- -module(cdrlib_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(default_timeout, ?t:minutes(3)). diff --git a/lib/orber/test/corba_SUITE.erl b/lib/orber/test/corba_SUITE.erl index 914856f370..018d8b5f12 100644 --- a/lib/orber/test/corba_SUITE.erl +++ b/lib/orber/test/corba_SUITE.erl @@ -26,7 +26,7 @@ %%----------------------------------------------------------------- -module(corba_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -include_lib("orber/COSS/CosNaming/CosNaming.hrl"). -include_lib("orber/src/orber_iiop.hrl"). diff --git a/lib/orber/test/csiv2_SUITE.erl b/lib/orber/test/csiv2_SUITE.erl index 7f45f16ef7..cf4dbec073 100644 --- a/lib/orber/test/csiv2_SUITE.erl +++ b/lib/orber/test/csiv2_SUITE.erl @@ -21,7 +21,7 @@ -module(csiv2_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -include_lib("orber/COSS/CosNaming/CosNaming.hrl"). -include_lib("orber/src/orber_iiop.hrl"). diff --git a/lib/orber/test/data_types_SUITE.erl b/lib/orber/test/data_types_SUITE.erl index d0e0eacad1..f910eecae7 100644 --- a/lib/orber/test/data_types_SUITE.erl +++ b/lib/orber/test/data_types_SUITE.erl @@ -26,7 +26,7 @@ -module(data_types_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -define(default_timeout, ?t:minutes(3)). diff --git a/lib/orber/test/generated_SUITE.erl b/lib/orber/test/generated_SUITE.erl index cc14b4ebc0..7af355620e 100644 --- a/lib/orber/test/generated_SUITE.erl +++ b/lib/orber/test/generated_SUITE.erl @@ -26,7 +26,7 @@ -module(generated_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -define(default_timeout, ?t:minutes(3)). diff --git a/lib/orber/test/interceptors_SUITE.erl b/lib/orber/test/interceptors_SUITE.erl index 57d5a5f831..ec30187aca 100644 --- a/lib/orber/test/interceptors_SUITE.erl +++ b/lib/orber/test/interceptors_SUITE.erl @@ -26,7 +26,7 @@ -module(interceptors_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -include_lib("orber/src/orber_iiop.hrl"). diff --git a/lib/orber/test/iop_ior_10_SUITE.erl b/lib/orber/test/iop_ior_10_SUITE.erl index 5705a95710..edfe566dcd 100644 --- a/lib/orber/test/iop_ior_10_SUITE.erl +++ b/lib/orber/test/iop_ior_10_SUITE.erl @@ -26,7 +26,7 @@ %%----------------------------------------------------------------- -module(iop_ior_10_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/src/orber_iiop.hrl"). -define(default_timeout, ?t:minutes(3)). diff --git a/lib/orber/test/iop_ior_11_SUITE.erl b/lib/orber/test/iop_ior_11_SUITE.erl index b32da44c68..d24e3fb882 100644 --- a/lib/orber/test/iop_ior_11_SUITE.erl +++ b/lib/orber/test/iop_ior_11_SUITE.erl @@ -26,7 +26,7 @@ %%----------------------------------------------------------------- -module(iop_ior_11_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/src/orber_iiop.hrl"). -define(default_timeout, ?t:minutes(3)). diff --git a/lib/orber/test/iop_ior_12_SUITE.erl b/lib/orber/test/iop_ior_12_SUITE.erl index a12f341f04..725118b609 100644 --- a/lib/orber/test/iop_ior_12_SUITE.erl +++ b/lib/orber/test/iop_ior_12_SUITE.erl @@ -27,7 +27,7 @@ -module(iop_ior_12_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/src/orber_iiop.hrl"). -define(default_timeout, ?t:minutes(3)). diff --git a/lib/orber/test/ip_v4v6_interop_SUITE.erl b/lib/orber/test/ip_v4v6_interop_SUITE.erl index 995a11ae1e..4840501418 100644 --- a/lib/orber/test/ip_v4v6_interop_SUITE.erl +++ b/lib/orber/test/ip_v4v6_interop_SUITE.erl @@ -47,7 +47,7 @@ %%---------------------------------------------------------------------- %% Include files %%---------------------------------------------------------------------- --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -include_lib("orber/COSS/CosNaming/CosNaming.hrl"). -include_lib("orber/src/orber_iiop.hrl"). diff --git a/lib/orber/test/lname_SUITE.erl b/lib/orber/test/lname_SUITE.erl index 2200ff6ed1..1fb4d7bbb9 100644 --- a/lib/orber/test/lname_SUITE.erl +++ b/lib/orber/test/lname_SUITE.erl @@ -26,7 +26,7 @@ %%----------------------------------------------------------------- -module(lname_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/COSS/CosNaming/CosNaming.hrl"). -include_lib("orber/COSS/CosNaming/lname.hrl"). diff --git a/lib/orber/test/multi_ORB_SUITE.erl b/lib/orber/test/multi_ORB_SUITE.erl index 6b523229cc..abedcec407 100644 --- a/lib/orber/test/multi_ORB_SUITE.erl +++ b/lib/orber/test/multi_ORB_SUITE.erl @@ -21,7 +21,7 @@ -module(multi_ORB_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -include_lib("orber/COSS/CosNaming/CosNaming.hrl"). -include_lib("orber/src/orber_iiop.hrl"). diff --git a/lib/orber/test/naming_context_SUITE.erl b/lib/orber/test/naming_context_SUITE.erl index f99820fa24..626b9237b5 100644 --- a/lib/orber/test/naming_context_SUITE.erl +++ b/lib/orber/test/naming_context_SUITE.erl @@ -26,7 +26,7 @@ %%----------------------------------------------------------------- -module(naming_context_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/COSS/CosNaming/CosNaming.hrl"). -include_lib("orber/src/orber_iiop.hrl"). -include_lib("orber/include/corba.hrl"). diff --git a/lib/orber/test/orber_SUITE.erl b/lib/orber/test/orber_SUITE.erl index 914705adb9..1ca22cd60b 100644 --- a/lib/orber/test/orber_SUITE.erl +++ b/lib/orber/test/orber_SUITE.erl @@ -19,7 +19,7 @@ %% %% -module(orber_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(default_timeout, ?t:minutes(15)). -define(application, orber). diff --git a/lib/orber/test/orber_acl_SUITE.erl b/lib/orber/test/orber_acl_SUITE.erl index 8d1f9ebb6d..0d8f79de5c 100644 --- a/lib/orber/test/orber_acl_SUITE.erl +++ b/lib/orber/test/orber_acl_SUITE.erl @@ -26,7 +26,7 @@ %%----------------------------------------------------------------- -module(orber_acl_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(default_timeout, ?t:minutes(5)). diff --git a/lib/orber/test/orber_firewall_ipv4_in_SUITE.erl b/lib/orber/test/orber_firewall_ipv4_in_SUITE.erl index 220029ec72..efa4f120c7 100644 --- a/lib/orber/test/orber_firewall_ipv4_in_SUITE.erl +++ b/lib/orber/test/orber_firewall_ipv4_in_SUITE.erl @@ -21,7 +21,7 @@ -module(orber_firewall_ipv4_in_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -include_lib("orber/COSS/CosNaming/CosNaming.hrl"). -include_lib("orber/src/orber_iiop.hrl"). diff --git a/lib/orber/test/orber_firewall_ipv4_out_SUITE.erl b/lib/orber/test/orber_firewall_ipv4_out_SUITE.erl index 270b166fe9..cfe1ab2d95 100644 --- a/lib/orber/test/orber_firewall_ipv4_out_SUITE.erl +++ b/lib/orber/test/orber_firewall_ipv4_out_SUITE.erl @@ -21,7 +21,7 @@ -module(orber_firewall_ipv4_out_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -include_lib("orber/COSS/CosNaming/CosNaming.hrl"). -include_lib("orber/src/orber_iiop.hrl"). diff --git a/lib/orber/test/orber_firewall_ipv6_in_SUITE.erl b/lib/orber/test/orber_firewall_ipv6_in_SUITE.erl index b0e28118f7..514504716f 100644 --- a/lib/orber/test/orber_firewall_ipv6_in_SUITE.erl +++ b/lib/orber/test/orber_firewall_ipv6_in_SUITE.erl @@ -21,7 +21,7 @@ -module(orber_firewall_ipv6_in_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -include_lib("orber/COSS/CosNaming/CosNaming.hrl"). -include_lib("orber/src/orber_iiop.hrl"). diff --git a/lib/orber/test/orber_firewall_ipv6_out_SUITE.erl b/lib/orber/test/orber_firewall_ipv6_out_SUITE.erl index 96884f3339..9ff57a0294 100644 --- a/lib/orber/test/orber_firewall_ipv6_out_SUITE.erl +++ b/lib/orber/test/orber_firewall_ipv6_out_SUITE.erl @@ -21,7 +21,7 @@ -module(orber_firewall_ipv6_out_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -include_lib("orber/COSS/CosNaming/CosNaming.hrl"). -include_lib("orber/src/orber_iiop.hrl"). diff --git a/lib/orber/test/orber_nat_SUITE.erl b/lib/orber/test/orber_nat_SUITE.erl index 1294f96681..0751cdf89c 100644 --- a/lib/orber/test/orber_nat_SUITE.erl +++ b/lib/orber/test/orber_nat_SUITE.erl @@ -21,7 +21,7 @@ -module(orber_nat_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -include_lib("orber/COSS/CosNaming/CosNaming.hrl"). -include_lib("orber/src/orber_iiop.hrl"). diff --git a/lib/orber/test/orber_test_lib.erl b/lib/orber/test/orber_test_lib.erl index 51025927ee..796ed21489 100644 --- a/lib/orber/test/orber_test_lib.erl +++ b/lib/orber/test/orber_test_lib.erl @@ -20,7 +20,7 @@ %% -module(orber_test_lib). --include("test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -include_lib("orber/include/ifr_types.hrl"). -include_lib("orber/src/orber_iiop.hrl"). diff --git a/lib/orber/test/orber_web_SUITE.erl b/lib/orber/test/orber_web_SUITE.erl index a88e0373bd..31c67be9d8 100644 --- a/lib/orber/test/orber_web_SUITE.erl +++ b/lib/orber/test/orber_web_SUITE.erl @@ -26,7 +26,7 @@ -module(orber_web_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -include_lib("orber/src/orber_iiop.hrl"). diff --git a/lib/orber/test/tc_SUITE.erl b/lib/orber/test/tc_SUITE.erl index a1a5c74ae3..c670ebdea2 100644 --- a/lib/orber/test/tc_SUITE.erl +++ b/lib/orber/test/tc_SUITE.erl @@ -26,7 +26,7 @@ %%----------------------------------------------------------------- -module(tc_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/src/orber_iiop.hrl"). -define(default_timeout, ?t:minutes(3)). diff --git a/lib/os_mon/test/Makefile b/lib/os_mon/test/Makefile index cdfc13a4c1..aace77a3f0 100644 --- a/lib/os_mon/test/Makefile +++ b/lib/os_mon/test/Makefile @@ -55,8 +55,7 @@ RELSYSDIR = $(RELEASE_PATH)/os_mon_test # FLAGS # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include \ - -I$(ERL_TOP)/lib/snmp/include +ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/snmp/include # ---------------------------------------------------- # Targets diff --git a/lib/os_mon/test/cpu_sup_SUITE.erl b/lib/os_mon/test/cpu_sup_SUITE.erl index e96b54d3fe..13d47c6a89 100644 --- a/lib/os_mon/test/cpu_sup_SUITE.erl +++ b/lib/os_mon/test/cpu_sup_SUITE.erl @@ -18,7 +18,7 @@ %% %CopyrightEnd% %% -module(cpu_sup_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Test server specific exports -export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2]). diff --git a/lib/os_mon/test/disksup_SUITE.erl b/lib/os_mon/test/disksup_SUITE.erl index e41fc73ab2..8e2825ec26 100644 --- a/lib/os_mon/test/disksup_SUITE.erl +++ b/lib/os_mon/test/disksup_SUITE.erl @@ -18,7 +18,7 @@ %% %CopyrightEnd% %% -module(disksup_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Test server specific exports -export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2]). diff --git a/lib/os_mon/test/memsup_SUITE.erl b/lib/os_mon/test/memsup_SUITE.erl index 8ab61e9581..904c9b95b0 100644 --- a/lib/os_mon/test/memsup_SUITE.erl +++ b/lib/os_mon/test/memsup_SUITE.erl @@ -18,7 +18,7 @@ %% %CopyrightEnd% %% -module(memsup_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Test server specific exports -export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2]). diff --git a/lib/os_mon/test/os_mon_SUITE.erl b/lib/os_mon/test/os_mon_SUITE.erl index 5c484ef2a6..0f7ae3a508 100644 --- a/lib/os_mon/test/os_mon_SUITE.erl +++ b/lib/os_mon/test/os_mon_SUITE.erl @@ -18,7 +18,7 @@ %% %CopyrightEnd% %% -module(os_mon_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Test server specific exports -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/lib/os_mon/test/os_mon_mib_SUITE.erl b/lib/os_mon/test/os_mon_mib_SUITE.erl index e68a139a74..f8fb9e20fc 100644 --- a/lib/os_mon/test/os_mon_mib_SUITE.erl +++ b/lib/os_mon/test/os_mon_mib_SUITE.erl @@ -30,7 +30,7 @@ %% > ct_run -suite os_mon_mib_SUITE -config os_mon_mib_SUITE.cfg %%----------------------------------------------------------------- --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("os_mon/include/OTP-OS-MON-MIB.hrl"). -include_lib("snmp/include/snmp_types.hrl"). diff --git a/lib/os_mon/test/os_sup_SUITE.erl b/lib/os_mon/test/os_sup_SUITE.erl index 768d95aebc..5857faa0a6 100644 --- a/lib/os_mon/test/os_sup_SUITE.erl +++ b/lib/os_mon/test/os_sup_SUITE.erl @@ -18,7 +18,7 @@ %% %CopyrightEnd% %% -module(os_sup_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Test server specific exports -export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2]). diff --git a/lib/ose/Makefile b/lib/ose/Makefile deleted file mode 100644 index 6119b75c3f..0000000000 --- a/lib/ose/Makefile +++ /dev/null @@ -1,37 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1996-2009. 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_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# -# Macros -# - -SUB_DIRECTORIES = src doc/src - -include vsn.mk -VSN = $(OSE_VSN) - -SPECIAL_TARGETS = - -# -# Default Subdir Targets -# -include $(ERL_TOP)/make/otp_subdir.mk diff --git a/lib/ose/doc/html/.gitignore b/lib/ose/doc/html/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/ose/doc/html/.gitignore +++ /dev/null diff --git a/lib/ose/doc/man3/.gitignore b/lib/ose/doc/man3/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/ose/doc/man3/.gitignore +++ /dev/null diff --git a/lib/ose/doc/man6/.gitignore b/lib/ose/doc/man6/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/ose/doc/man6/.gitignore +++ /dev/null diff --git a/lib/ose/doc/pdf/.gitignore b/lib/ose/doc/pdf/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/ose/doc/pdf/.gitignore +++ /dev/null diff --git a/lib/ose/doc/src/.gitignore b/lib/ose/doc/src/.gitignore deleted file mode 100644 index 860e9e703e..0000000000 --- a/lib/ose/doc/src/.gitignore +++ /dev/null @@ -1 +0,0 @@ -ose.xml diff --git a/lib/ose/doc/src/Makefile b/lib/ose/doc/src/Makefile deleted file mode 100644 index 7ebd4125ba..0000000000 --- a/lib/ose/doc/src/Makefile +++ /dev/null @@ -1,133 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1997-2012. 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_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../../vsn.mk -VSN=$(OSE_VSN) -APPLICATION=ose - -# ---------------------------------------------------- -# 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 -# ---------------------------------------------------- -XML_APPLICATION_FILES = ref_man.xml - -XML_REF3_FILES = \ - ose.xml \ - ose_erl_driver.xml - -XML_REF6_FILES = ose_app.xml - -XML_PART_FILES = part.xml -XML_CHAPTER_FILES = notes.xml ose_intro.xml ose_signals_chapter.xml - -BOOK_FILES = book.xml - -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 = - -TOP_SPECS_FILE = - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -XML_FLAGS += - -SPECS_FLAGS = -I../../include -I../../../kernel/include - -OSE_SRC_DIR = ../../src - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -docs: man pdf html - -$(TOP_PDF_FILE): $(XML_FILES) - -pdf: $(TOP_PDF_FILE) - -html: $(HTML_REF_MAN_FILE) - -man: $(MAN3_FILES) $(MAN6_FILES) - -ose.xml: $(OSE_SRC_DIR)/ose.erl - escript $(DOCGEN)/priv/bin/xml_from_edoc.escript\ - $(OSE_SRC_DIR)/$(@:%.xml=%.erl) - -debug opt: - -clean clean_docs: - rm -rf $(HTMLDIR)/* - 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/man3" - $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man6" - $(INSTALL_DATA) $(MAN6_FILES) "$(RELEASE_PATH)/man/man6" - -release_spec: diff --git a/lib/ose/doc/src/book.xml b/lib/ose/doc/src/book.xml deleted file mode 100644 index d62e0d32f4..0000000000 --- a/lib/ose/doc/src/book.xml +++ /dev/null @@ -1,49 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE book SYSTEM "book.dtd"> - -<book xmlns:xi="http://www.w3.org/2001/XInclude"> - <header titlestyle="normal"> - <copyright> - <year>2014</year><year>2014</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>OSE</title> - <prepared>Lukas Larsson</prepared> - <docno></docno> - <date>2014-01-08</date> - <rev>1.0</rev> - <file>book.xml</file> - </header> - <insidecover> - </insidecover> - <pagetext>OSE</pagetext> - <preamble> - <contents level="2"></contents> - </preamble> - <parts> - <xi:include href="part.xml"/> - </parts> - <applications> - <xi:include href="ref_man.xml"/> - </applications> - <releasenotes> - <xi:include href="notes.xml"/> - </releasenotes> - <listofterms></listofterms> - <index></index> -</book> diff --git a/lib/ose/doc/src/notes.xml b/lib/ose/doc/src/notes.xml deleted file mode 100644 index 06881b6c99..0000000000 --- a/lib/ose/doc/src/notes.xml +++ /dev/null @@ -1,109 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE chapter SYSTEM "chapter.dtd"> - -<chapter> - <header> - <copyright> - <year>2014</year><year>2014</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>OSE Release Notes</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - <file>notes.xml</file> - </header> - <p>This document describes the changes made to the OSE application.</p> - -<section><title>Ose 1.1</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - Change license text from Erlang Public License to Apache - Public License v2</p> - <p> - Own Id: OTP-12845</p> - </item> - </list> - </section> - -</section> - -<section><title>Ose 1.0.2</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - Add missing release notes for the OSE application.</p> - <p> - Own Id: OTP-12177</p> - </item> - </list> - </section> - -</section> - -<section><title>Ose 1.0.1</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - Fix some spelling mistakes in documentation</p> - <p> - Own Id: OTP-12152</p> - </item> - </list> - </section> - -</section> - -<section><title>Ose 1.0</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - Erlang/OTP has been ported to the realtime operating - system OSE. The port supports both smp and non-smp - emulator. For details around the port and how to started - see the User's Guide in the <seealso - marker="ose:ose_intro">ose</seealso> application. </p> - <p> - Note that not all parts of Erlang/OTP has been ported. </p> - <p> - Notable things that work are: non-smp and smp emulators, - OSE signal interaction, crypto, asn1, run_erl/to_erl, - tcp, epmd, distribution and most if not all non-os - specific functionality of Erlang.</p> - <p> - Notable things that does not work are: udp/sctp, os_mon, - erl_interface, binding of schedulers.</p> - <p> - Own Id: OTP-11334</p> - </item> - </list> - </section> - -</section> - -</chapter> diff --git a/lib/ose/doc/src/ose_erl_driver.xml b/lib/ose/doc/src/ose_erl_driver.xml deleted file mode 100644 index b804c29d2d..0000000000 --- a/lib/ose/doc/src/ose_erl_driver.xml +++ /dev/null @@ -1,111 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE cref SYSTEM "cref.dtd"> - -<cref> - <header> - <copyright> - <year>2013</year><year>2014</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_driver for Enea OSE</title> - <prepared>Lukas Larsson</prepared> - <docno></docno> - <date>2014-01-08</date> - <rev>A</rev> - <file>ose_erl_driver.xml</file> - </header> - <lib>ose_erl_driver</lib> - <libsummary>Linked-in drivers in Enea OSE</libsummary> - <description> - <p>Writing Linked-in drivers that also work on Enea OSE is very similar for - how you would do it for Unix. The difference from Unix is that - driver_select, ready_input and ready_output all work with signals - instead of file descriptors. This means that the driver_select is - used to specify which type of signal should trigger calls to - ready_input/ready_output. The functions described below are available - to driver programmers on Enea OSE to facilitate this. - </p> - </description> - <section> - <title>DATA TYPES</title> - - <taglist> - <tag><marker id="union_SIGNAL"/>union SIGNAL</tag> - <item>See the Enea OSE SPI documentation for a description.</item> - <tag><marker id="SIGSELECT"/>SIGSELECT</tag> - <item>See the Enea OSE SPI documentation for a description.</item> - <tag><marker id="ErlDrvEvent"/>ErlDrvEvent</tag> - <item>The <c>ErlDrvEvent</c> is a handle to a signal number and id combination. It is passed to <seealso marker="erts:erl_driver#driver_select">driver_select(3)</seealso>.</item> - <tag><marker id="ErlDrvOseEventId"/>ErlDrvOseEventId</tag> - <item>This is the id used to associate a specific signal to a - certain driver instance. </item> - </taglist> - </section> - <funcs> - <func> - <name><ret>union SIGNAL *</ret><nametext>erl_drv_ose_get_signal(ErlDrvEvent drv_event)</nametext></name> - <desc> - <marker id="erl_drv_ose_get_signal"></marker> - <p>Fetch the next signal associated with <c>drv_event</c>. - Signals will be returned in the order which they were received and - when no more signals are available <c>NULL</c> will be returned. - Use this function in the ready_input/ready_output callbacks - to get signals.</p> - </desc> - </func> - <func> - <name><ret>ErlDrvEvent</ret><nametext>erl_drv_ose_event_alloc(SIGSELECT signo, ErlDrvOseEventId id, ErlDrvOseEventId (*resolve_signal)(union SIGNAL* sig), void *extra)</nametext></name> - <desc> - <marker id="erl_drv_ose_event_alloc"></marker> - <p>Create a new <c>ErlDrvEvent</c> associated with <c>signo</c>, - <c>id</c> and uses the <c>resolve_signal</c> function to extract - the <c>id</c> from a signal with <c>signo</c>. The <c>extra</c> - parameter can be used for additional data. See - <seealso marker="ose_signals_chapter#driver"> - Signals in a Linked-in driver</seealso> in the OSE User's Guide. - </p> - </desc> - </func> - <func> - <name><ret>void</ret><nametext>erl_drv_ose_event_free(ErlDrvEvent drv_event)</nametext></name> - <desc> - <marker id="erl_drv_ose_event_free"></marker> - <p>Free a <c>ErlDrvEvent</c>. This should always be done in the - <seealso marker="erts:driver_entry#stop_select">stop_select</seealso> - callback when the event is no longer being used.</p> - </desc> - </func> - <func> - <name><ret>void</ret><nametext>erl_drv_ose_event_fetch(ErlDrvEvent drv_event, SIGSELECT *signo, ErlDrvOseEventId *id, void **extra)</nametext></name> - <desc> - <marker id="erl_drv_ose_event_fetch"></marker> - <p>Write the signal number, id and any extra data associated with <c>drv_event</c> - into <c>*signo</c> and <c>*id</c> respectively. <c>NULL</c> can be - also passed as <c>signo</c> or <c>id</c> in order to ignore that field. - </p> - </desc> - </func> - </funcs> - <section> - <title>SEE ALSO</title> - <p> - <seealso marker="erts:driver_entry">driver_entry(3)</seealso>, - <seealso marker="erts:erl_driver">erl_driver(3)</seealso> - </p> - </section> -</cref> diff --git a/lib/ose/doc/src/ose_intro.xml b/lib/ose/doc/src/ose_intro.xml deleted file mode 100644 index 982516c8bd..0000000000 --- a/lib/ose/doc/src/ose_intro.xml +++ /dev/null @@ -1,154 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE chapter SYSTEM "chapter.dtd"> - -<chapter> - <header> - <copyright> - <year>2013</year><year>2014</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>Introduction</title> - <prepared>Lukas Larsson</prepared> - <docno></docno> - <date>2014-01-08</date> - <rev>A</rev> - <file>ose_intro.xml</file> - </header> - - <section> - <title>Features</title> - </section> - - <section> - <title>Starting Erlang/OTP</title> - <p> - Starting Erlang/OTP on OSE is not as simple as on Unix/Windows (yet). - First of all you have to explicitly use the beam (or beam.smp) executables - found in erts-X.Y.Z/bin as the load module that you run. This in turn - means that you have to supply the raw beam arguments to the emulator - when starting. Fortunately <c>erl</c> on Unix/Windows has a - undocumented flag called <c>-emu_args_exit</c> that can be used to - figure out what the arguments to beam look like. For example:</p> - <code># erl +Mut false +A 10 +S 4:4 +Muycs256 +P 2096 +Q 2096 -emu_args_exit --Mut -false --A -10 --S -4:4 --Muycs256 --P -2096 --Q -2096 --- --root -/usr/local/lib/erlang --progname -erl --- --home -/home/erlang ---</code> - <p> - The arguments are printed on separate lines to make it possible to know - what has to be quoted with ". Each line is one quotable unit. - So taking the arguments above you can supply them to pm_create or - just execute directly on the command line. For example:</p> - <code>rtose@acp3400> pm_install erlang /mst/erlang/erts-6.0/bin/beam.smp -rtose@acp3400> pm_create -c ARGV="-Mut false -A 10 -S 4:4 -Muycs256 -P 2096 -Q 2099 -- -root /mst/erlang -progname erl -- -home /mst/erlang --" erlang -pid: 0x110059 -rtose@acp3400> pm_start 0x110059</code> - <p> - Also note that since we are running erl to figure out the arguments on a - separate machine the paths have to be updated. In the example above - <c>/usr/local/lib/erlang</c> was replaced by <c>/mst/erlang/</c>. The - goal is to in future releases not have to do the special argument handling - but for now (OTP 17.0) you have to do it. - </p> - <note> - Because of a limitation in the way the OSE handles stdio when starting - load modules using pm_install/create the Erlang shell only reads every - other command from stdin. However if you start Erlang using run_erl - you do not have this problem. So it is highly recommended that you - start Erlang using run_erl. - </note> - </section> - - <section> - <title>run_erl and to_erl</title> - <p> - In OSE run_erl and to_erl are combined into a single load module called - run_erl_lm. Installing and starting the load module will add two new - shell commands called run_erl and to_erl. They work in exactly the same - way as the unix variants of run_erl and to_erl, except that the read - and write pipes have to be placed under the /pipe vm. One additional - option also exists to run_erl on ose: - <taglist> - <tag><c>-block Name</c></tag> - <item>The name of the install handle and block that will be created/used by - installing and exectuting the first part of the command. If nothing - if given the basename of the load module will be used for this value. - Example: - <code>pm_install erlang /path/to/erlang/vm/beam.smp -run_erl -daemon -block erlang /pipe/ /mst/erlang_logs/ "beam.smp -A 1 -- -root /mst/erlang -- -home /mst --"</code> - </item> - </taglist> - The same argument munching as when starting Erlang/OTP without run_erl - has to be done. If <c>-daemon</c> is given then all error printouts - are sent to the ramlog. - See also - <seealso marker="erts:run_erl">run_erl</seealso> for more details. - </p> - <p> - Below is an example of how to get started with <c>run_erl_lm</c>. - <code>rtose@acp3400> pm_install run_erl_lm /mst/erlang/erts-6.0/bin/run_erl_lm -rtose@acp3400> pm_create run_erl_lm -pid: 0x1c005d -rtose@acp3400> pm_start 0x1c005d -rtose@acp3400> mkdir /mst/erlang_log -rtose@acp3400> run_erl -daemon /pipe/ /mst/erlang_log/ "/mst/erlang/erts-6.0/bin/beam.smp -A 1 -- -root /mst/erlang -- -home /mst --" -rtose@acp3400> to_erl -Attaching to /pipe/erlang.pipe.1 (^C to exit) -os:type(). -{ose,release} -2> -'to_erl' terminated.</code> - Note that Ctrl-C is used instead of Ctrl-D to exit the to_erl shell. - </p> - </section> - - <section> - <title>epmd</title> - <p> - In OSE epmd will not be started automatically so if you want to use - Erlang distribution you have to manually start epmd. - </p> - </section> - - <section> - <title>VM Process Priorities</title> - <p> - It is possible to set the priorities you want for the OSE processes that - thr emulator creates in the lmconf. An example of how to do it can be - found in the default lmconf file in - $ERL_TOP/erts/emulator/sys/ose/beam.lmconf. - </p> - </section> - -</chapter> diff --git a/lib/ose/doc/src/ose_signals_chapter.xml b/lib/ose/doc/src/ose_signals_chapter.xml deleted file mode 100644 index bcf2259577..0000000000 --- a/lib/ose/doc/src/ose_signals_chapter.xml +++ /dev/null @@ -1,240 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE chapter SYSTEM "chapter.dtd"> - -<chapter> - <header> - <copyright> - <year>2013</year><year>2014</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>Interacting with Enea OSE</title> - <prepared>Lukas Larsson</prepared> - <docno></docno> - <date>2014-01-08</date> - <rev>A</rev> - <file>ose_signals_chapter.xml</file> - </header> - - <marker id="introduction"></marker> - <section> - <title>Introduction</title> - <p>The main way which programs on Enea OSE interact is through the - usage of message passing, much the same way as Erlang processes - communicate. There are two ways in which an Erlang programmer can - interact with the signals sent from other Enea OSE processes; either - through the provided <c>ose</c> module, or by writing a custom linked-in - driver. This User's Guide describes and provides examples for both - approaches. - </p> - </section> - - <marker id="erlang"></marker> - <section> - <title>Signals in Erlang</title> - <p>Erlang/OTP on OSE provides a erlang module called - <seealso marker="ose:ose">ose</seealso> that can be used to interact - with other OSE processes using message passing. The api in the module - is very similar to the native OSE api, so for details of how the - functions work please refer to the official OSE documenation. Below - is an example usage of the API. - </p> - <code>1> P1 = ose:open("p1"). -#Port>0.344> -2> ose:hunt(P1,"p2"). -{#Port>0.344>,1} -3> P2 = ose:open("p2"). -#Port>0.355> -4> flush(). -Shell got {mailbox_up,#Port>0.344>,{#Port>0.344>,1},852189} -ok -5> ose:listen(P1,[1234]). -ok -6> ose:send(P2,ose:get_id(P1),1234,>>"hello">>). -ok -7> flush(). -Shell got {message,#Port>0.344>,{852189,1245316,1234,>>"hello">>}} -ok</code> - </section> - - <marker id="driver"></marker> - <section> - <title>Signals in a Linked-in driver</title> - <p> - Writing Linked-in drivers for OSE is very similar to how it is done - for Unix/Windows. It is only the way in which the driver subscribes - and consumed external events that is different. In Unix (and Windows) - file descriptiors (and Event Objects) are used to select on. On OSE - we use signals to deliver the same functionality. There are two large - differences between a signal and an fd. - </p> - <p> - In OSE it is not possible for a signal number to be a unique identifier - for a resource in the same way as an fd is. For example; let's say we - implement a driver that does an asynchronous hunt that uses signal - number 1234 as the hunt_sig. If we want to be able to have multiple - hunt ports running at the same time we have to have someway of routing - the signal to the correct port. This is achieved by supplying a secondary - id that can be retrieved through the meta-data or payload of the signal, - e.g: - <code>ErlDrvEvent event = erl_drv_ose_event_alloc(1234,port,resolver);</code> - The event you get back from - <seealso marker="ose_erl_driver#erl_drv_ose_event_alloc"> - erl_drv_ose_event_alloc</seealso> can then be used by - <seealso marker="erts:erl_driver#driver_select">driver_select</seealso> - to subscribe to signals. The first argument is just the signal number - that we are interested in. The second is the id that we choose to use, - in this case the port id that we got in the - <seealso marker="erts:driver_entry#start">start</seealso> callback is - used. The third argument is a function pointer to a function that can - be used to figure out the id from a given signal. The fourth argument can - point to any additional data you might want to associate with the event. - There is a complete. You can examine the data contained in the event with - <seealso marker="ose_erl_driver#erl_drv_ose_event_fetch">erl_drv_ose_event_fetch</seealso> - , eg: - <code>erl_drv_ose_event_fetch(event, &signal, &port, (void **)&extra);</code> - example of what this could look like in - <seealso marker="#example">the next section</seealso>. - <note>It is very important to issue the driver_select call before - any of the signals you are interested in are sent. If driver_select - is called after the signal is sent, there is a high probability that it - will be lost.</note> - </p> - <p> - The other difference from unix is that in OSE the payload of the event - (i.e. the signal data) is already received when the ready_output/input - callbacks are called. This means that you access the data of a signal - by calling <seealso marker="ose_erl_driver#erl_drv_ose_get_signal"> - erl_drv_ose_get_signal</seealso>. Additionally multiple signals might be - associated with the event, so you should call - <seealso marker="ose_erl_driver#erl_drv_ose_get_signal"> - erl_drv_ose_get_signal</seealso> until <c>NULL</c> is returned. - </p> - </section> - - <marker id="example"></marker> - <section> - <title>Example Linked-in driver</title> -<code>#include "erl_driver.h" -#include "ose.h" - -struct huntsig { - SIGSELECT signo; - ErlDrvPort port; -}; - -union SIGNAL { - SIGSELECT signo; - struct huntsig; -} - -/* Here we have to get the id from the signal. In this case we use the - port id since we have control over the data structure of the signal. - It is however possible to use anything in here. The only restriction - is that the same id has to be used for all signals of the same number.*/ -ErlDrvOseEventId resolver(union SIGNAL *sig) { - return (ErlDrvOseEventId)sig->huntsig.port; -} - -static int drv_init(void) { return 0; }; - -static ErlDrvData drv_start(ErlDrvPort port, char *command) { - return (ErlDrvData)port; -} - -static ErlDrvSSizeT control(ErlDrvData driver_data, unsigned int cmd, - char *buf, ErlDrvSizeT len, - char **rbuf, ErlDrvSizeT rlen) { - ErlDrvPort port = (ErlDrvPort)driver_data; - - /* An example of extra data to associate with the event */ - char *extra_data = driver_alloc(80); - snprintf("extra_data, "Event, sig_no: 1234, and port: %d", port); - - /* Create a new event to select on */ - ErlDrvOseEvent evt = erl_drv_ose_event_alloc(1234,port,resolver, extra_data); - - /* Make sure to do the select call _BEFORE_ the signal arrives. - The signal might get lost if the hunt call is done before the - select. */ - driver_select(port,evt,ERL_DRV_READ|ERL_DRV_USE,1); - - union SIGNAL *sig = alloc(sizeof(union SIGNAL),1234); - sig->huntsig.port = port; - hunt("testprocess",0,NULL,&sig); - return 0; -} - -static void ready_input(ErlDrvData driver_data, ErlDrvEvent evt) { - char *extra_data; - /* Get the first signal payload from the event */ - union SIGNAL *sig = erl_drv_ose_get_signal(evt); - ErlDrvPort port = (ErlDrvPort)driver_data; - while (sig != NULL) { - if (sig->signo == 1234) { - /* Print out the string we added as the extra parameter */ - erl_drv_ose_event_fetch(evt, NULL, NULL, (void **)&extra_data); - printf("We've received: %s\n", extra_data); - - /* If it is our signal we send a message with the sender of the signal - to the controlling erlang process */ - ErlDrvTermData reply[] = { ERL_DRV_UINT, (ErlDrvUInt)sender(&sig) }; - erl_drv_send_term(port,reply,sizeof(reply) / sizeof(reply[0])); - } - - /* Cleanup the signal and deselect on the event. - Note that the event itself has to be free'd in the stop_select - callback. */ - free_buf(&sig); - driver_select(port,evt,ERL_DRV_READ|ERL_DRV_USE,0); - - /* There could be more than one signal waiting in this event, so - we have to loop until sig == NULL */ - sig = erl_drv_ose_get_signal(evt); - } -} - -static void stop_select(ErlDrvEvent event, void *reserved) -{ - /* Free the extra_data */ - erl_drv_ose_event_fetch(evt, NULL, NULL, (void **)&extra_data); - driver_free(extra_data); - - /* Free the event itself */ - erl_drv_ose_event_free(event); -} - -/** - * Setup the driver entry for the Erlang runtime - **/ -ErlDrvEntry ose_signal_driver_entry = { - .init = drv_init, - .start = drv_start, - .stop = drv_stop, - .ready_input = ready_input, - .driver_name = DRIVER_NAME, - .control = control, - .extended_marker = ERL_DRV_EXTENDED_MARKER, - .major_version = ERL_DRV_EXTENDED_MAJOR_VERSION, - .minor_version = ERL_DRV_EXTENDED_MINOR_VERSION, - .driver_flags = ERL_DRV_FLAG_USE_PORT_LOCKING, - .stop_select = stop_select -}; -</code> - </section> - -</chapter> diff --git a/lib/ose/doc/src/part.xml b/lib/ose/doc/src/part.xml deleted file mode 100644 index 0c9ebd16c0..0000000000 --- a/lib/ose/doc/src/part.xml +++ /dev/null @@ -1,39 +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>2014</year> - <year>2014</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. - - The Initial Developer of the Original Code is Ericsson AB. - </legalnotice> - - <title>OSE User's Guide</title> - <prepared>Lukas Larsson</prepared> - <docno></docno> - <date>2014-01-08</date> - <rev>1.0</rev> - <file>part.xml</file> - </header> - <description> - <p><em>OSE</em>.</p> - </description> - <xi:include href="ose_intro.xml"/> - <xi:include href="ose_signals_chapter.xml"/> -</part> diff --git a/lib/ose/doc/src/ref_man.xml b/lib/ose/doc/src/ref_man.xml deleted file mode 100644 index 964e5ab8ff..0000000000 --- a/lib/ose/doc/src/ref_man.xml +++ /dev/null @@ -1,40 +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>2014</year><year>2014</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>OSE Reference Manual</title> - <prepared>Lukas Larsson</prepared> - <docno></docno> - <date>2014-01-08</date> - <rev>1.0</rev> - <file>ref_man.xml</file> - </header> - <description> - <p>The Standard Erlang Libraries application, <em>STDLIB</em>, - contains modules for manipulating lists, strings and files etc.</p> - <br></br> - </description> - <xi:include href="ose_app.xml"/> - <xi:include href="ose.xml"/> - <xi:include href="ose_erl_driver.xml"/> -</application> diff --git a/lib/ose/ebin/.gitignore b/lib/ose/ebin/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/ose/ebin/.gitignore +++ /dev/null diff --git a/lib/ose/include/.gitignore b/lib/ose/include/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/ose/include/.gitignore +++ /dev/null diff --git a/lib/ose/info b/lib/ose/info deleted file mode 100644 index 85c07dbe82..0000000000 --- a/lib/ose/info +++ /dev/null @@ -1,2 +0,0 @@ -group: misc Miscellaneous Applications -short: Description of Enea OSE specific functionality diff --git a/lib/ose/src/Makefile b/lib/ose/src/Makefile deleted file mode 100644 index a89e9392e9..0000000000 --- a/lib/ose/src/Makefile +++ /dev/null @@ -1,107 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1996-2013. 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_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../vsn.mk -VSN=$(OSE_VSN) - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/ose-$(VSN) - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- -MODULES= \ - ose - -HRL_FILES= - -INTERNAL_HRL_FILES= - -ERL_FILES= $(MODULES:%=%.erl) - -TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) $(APP_TARGET) $(APPUP_TARGET) - -APP_FILE= ose.app - -APP_SRC= $(APP_FILE).src -APP_TARGET= $(EBIN)/$(APP_FILE) - -APPUP_FILE= ose.appup - -APPUP_SRC= $(APPUP_FILE).src -APPUP_TARGET= $(EBIN)/$(APPUP_FILE) - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- - -ifeq ($(NATIVE_LIBS_ENABLED),yes) -ERL_COMPILE_FLAGS += +native -endif -ERL_COMPILE_FLAGS += -I../include -I../../kernel/include -Werror - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -debug opt: $(TARGET_FILES) - -clean: - rm -f $(TARGET_FILES) - rm -f core - rm -f erl_parse.erl - -docs: - -# ---------------------------------------------------- -# Special Build Targets -# ---------------------------------------------------- - -$(APP_TARGET): $(APP_SRC) ../vsn.mk - $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@ - -$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk - $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@ - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_spec: opt - $(INSTALL_DIR) "$(RELSYSDIR)/src" - $(INSTALL_DATA) $(ERL_FILES) "$(RELSYSDIR)/src" - $(INSTALL_DIR) "$(RELSYSDIR)/include" - $(INSTALL_DIR) "$(RELSYSDIR)/ebin" - $(INSTALL_DATA) $(TARGET_FILES) "$(RELSYSDIR)/ebin" - -release_docs_spec: - -# ---------------------------------------------------- -# Dependencies -- alphabetically, please -# ---------------------------------------------------- diff --git a/lib/ose/src/ose.app.src b/lib/ose/src/ose.app.src deleted file mode 100644 index 036779eb16..0000000000 --- a/lib/ose/src/ose.app.src +++ /dev/null @@ -1,28 +0,0 @@ -%% This is an -*- erlang -*- file. -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2011. 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% -%% -{application, ose, - [{description, "Enea OSE specific modules"}, - {vsn, "%VSN%"}, - {modules, [ose]}, - {registered,[]}, - {applications, [stdlib,kernel]}, - {env, []}, - {runtime_dependencies, ["stdlib-2.0","erts-6.0"]}]}. diff --git a/lib/ose/src/ose.appup.src b/lib/ose/src/ose.appup.src deleted file mode 100644 index 28b6da3439..0000000000 --- a/lib/ose/src/ose.appup.src +++ /dev/null @@ -1,23 +0,0 @@ -%% -*- erlang -*- -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2013. 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% -{"%VSN%", - [ - ], - [ - ]}. diff --git a/lib/ose/src/ose.erl b/lib/ose/src/ose.erl deleted file mode 100644 index 5534dba4d4..0000000000 --- a/lib/ose/src/ose.erl +++ /dev/null @@ -1,453 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2013. 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% -%% -%% @doc Interface module for OSE messaging and process monitoring from Erlang -%% -%% For each mailbox created through {@link open/1} a OSE phantom process with -%% that name is started. Since phantom processes are used the memory footprint -%% of each mailbox is quite small. -%% -%% To receive messages you first have to subscribe to the specific message -%% numbers that you are interested in with {@link listen/2}. The messages -%% will be sent to the Erlang process that created the mailbox. -%% -%% @end -%% --module(ose). - -%%============================================================================== -%% Exported API -%%============================================================================== --export([open/1, - close/1, - get_id/1, - get_name/2, - hunt/2, - dehunt/2, - attach/2, - detach/2, - send/4, - send/5, - listen/2 - ]). - -%%============================================================================== -%% Types -%%============================================================================== --opaque mailbox() :: port(). -%% Mailbox handle. Implemented as an erlang port. - --opaque mailbox_id() :: integer(). -%% Mailbox ID, this is the same as the process id of an OSE process. -%% An integer. - --type message_number() :: 0..4294967295. -%% OSE Signal number - --opaque hunt_ref() :: {mailbox(),integer()}. -%% Reference from a hunt request. This term will be included -%% in a successful hunt response. - --opaque attach_ref() :: {mailbox(),integer()}. -%% Reference from an attach request. This term will be included -%% in the term returned when the attached mailbox disappears. - --export_type([mailbox_id/0, - message_number/0, - mailbox/0, - hunt_ref/0, - attach_ref/0]). - -%%============================================================================== -%% Defines -%%============================================================================== --define(DRIVER_NAME, "ose_signal_drv"). --define(GET_SPID, 1). --define(GET_NAME, 2). --define(HUNT, 100). --define(DEHUNT, 101). --define(ATTACH, 102). --define(DETACH, 103). --define(SEND, 104). --define(SEND_W_S, 105). --define(LISTEN, 106). --define(OPEN, 200). - --define(INT_32BIT(Int),(is_integer(Int) andalso (Int >= 0) andalso (Int < (1 bsl 32)))). - -%%============================================================================== -%% API functions -%%============================================================================== - -%%------------------------------------------------------------------------------ -%% @doc Create a mailbox with the given name and return a port that handles -%% the mailbox. -%% -%% An OSE phantom process with the given name will be created that will send any -%% messages sent through this mailbox. Any messages sent to the new OSE process -%% will automatically be converted to an Erlang message and sent to the Erlang -%% process that calls this function. See {@link listen/2} for details about the -%% format of the message sent. -%% -%% The caller gets linked to the created mailbox. -%% -%% raises: `badarg' | `system_limit' -%% -%% @see listen/2 -%% @end -%%------------------------------------------------------------------------------ --spec open(Name) -> Port when - Name :: iodata(), - Port :: mailbox(). -open(Name) -> - try open_port({spawn_driver,?DRIVER_NAME}, [binary]) of - Port -> - try port_command(Port,[?OPEN,Name]) of - true -> - receive - {ose_drv_reply,Port,{error,Error}} -> - close(Port), - erlang:error(Error,[Name]); - {ose_drv_reply,Port,ok} -> - Port - end - catch - error:badarg -> close(Port),erlang:error(badarg,[Name]) - end - catch - error:badarg -> erlang:error(badarg,[Name]) - end. - -%%------------------------------------------------------------------------------ -%% @doc Close a mailbox -%% -%% This kills the OSE phantom process associated with this mailbox. -%% -%% Will also consume any ``{'EXIT',Port,_}'' message from the port that comes -%% due to the port closing when the calling process traps exits. -%% -%% raises: `badarg' -%% @end -%%------------------------------------------------------------------------------ --spec close(Port) -> ok when - Port :: mailbox(). -close(Port) when is_port(Port) -> - %% Copied from prim_inet - case erlang:process_info(self(), trap_exit) of - {trap_exit,true} -> - link(Port), - catch erlang:port_close(Port), - receive {'EXIT',Port,_} -> ok end; - {trap_exit,false} -> - catch erlang:port_close(Port), - ok - end; -close(NotPort) -> - erlang:error(badarg,[NotPort]). - -%%------------------------------------------------------------------------------ -%% @doc Get the mailbox id for the given port. -%% -%% The mailbox id is the same as the OSE process id of the OSE phantom process -%% that this mailbox represents. -%% -%% raises: `badarg' -%% @end -%%------------------------------------------------------------------------------ --spec get_id(Port) -> Pid when - Port :: mailbox(), - Pid :: mailbox_id(). -get_id(Port) -> - try port_control(Port, ?GET_SPID, <<>>) of - <<Spid:32>> -> Spid - catch error:_Error -> - erlang:error(badarg,[Port]) - end. - -%%------------------------------------------------------------------------------ -%% @doc Get the mailbox name for the given mailbox id. -%% -%% The mailbox name is the name of the OSE process with process id Pid. -%% -%% This call will fail with badarg if the underlying system does not support -%% getting the name from a process id. -%% -%% raises: `badarg' -%% @end -%%------------------------------------------------------------------------------ --spec get_name(Port, Pid) -> Name | undefined when - Port :: mailbox(), - Pid :: mailbox_id(), - Name :: binary(). -get_name(Port, Pid) when ?INT_32BIT(Pid) -> - try port_control(Port, ?GET_NAME, <<Pid:32>>) of - [] -> undefined; - Res -> Res - catch error:_Error -> - erlang:error(badarg,[Port,Pid]) - end; -get_name(Port, Pid) -> - erlang:error(badarg,[Port,Pid]). - - -%%------------------------------------------------------------------------------ -%% @doc Hunt for OSE process by name. -%% -%% Will send `{mailbox_up, Port, Ref, MboxId}' -%% to the calling process when the OSE process becomes available. -%% -%% Returns a reference term that can be used to cancel the hunt -%% using {@link dehunt/2}. -%% -%% raises: `badarg' -%% -%% @end -%%------------------------------------------------------------------------------ --spec hunt(Port, HuntPath) -> Ref when - Port :: mailbox(), - HuntPath :: iodata(), - Ref :: hunt_ref(). -hunt(Port, HuntPath) -> - try port_command(Port, [?HUNT,HuntPath]) of - true -> - receive - {ose_drv_reply,Port,{error,Error}} -> - erlang:error(Error,[Port,HuntPath]); - {ose_drv_reply,Port,Ref} -> - Ref - end - catch error:_Error -> - erlang:error(badarg,[Port,HuntPath]) - end. - -%%------------------------------------------------------------------------------ -%% @doc Stop hunting for OSE process. -%% -%% If a message for this hunt has been sent but not received -%% by the calling process, it is removed from the message queue. -%% Note that this only works if the same process that did -%% the hunt does the dehunt. -%% -%% raises: `badarg' -%% -%% @see hunt/2 -%% @end -%%------------------------------------------------------------------------------ --spec dehunt(Port, Ref) -> ok when - Port :: mailbox(), - Ref :: hunt_ref(). -dehunt(Port, {Port,Ref}) when ?INT_32BIT(Ref) -> - try port_command(Port, <<?DEHUNT:8, Ref:32>>) of - true -> - receive - {ose_drv_reply,Port,{error,enoent}} -> - %% enoent could mean that it is in the message queue - receive - {mailbox_up, Port, {Port,Ref}, _} -> - ok - after 0 -> - ok - end; - {ose_drv_reply,Port,ok} -> - ok - end - catch error:_Error -> - erlang:error(badarg,[Port,{Port,Ref}]) - end; -dehunt(Port,Ref) -> - erlang:error(badarg,[Port,Ref]). - -%%------------------------------------------------------------------------------ -%% @doc Attach to an OSE process. -%% -%% Will send `{mailbox_down, Port, Ref, MboxId}' -%% to the calling process if the OSE process exits. -%% -%% Returns a reference that can be used to cancel the attachment -%% using {@link detach/2}. -%% -%% raises: `badarg' | `enomem' -%% -%% @end -%%------------------------------------------------------------------------------ --spec attach(Port,Pid) -> Ref when - Port :: mailbox(), - Pid :: mailbox_id(), - Ref :: attach_ref(). -attach(Port, Spid) when ?INT_32BIT(Spid) -> - try port_command(Port, <<?ATTACH:8, Spid:32>>) of - true -> - receive - {ose_drv_reply,Port,{error,Error}} -> - erlang:error(Error,[Port,Spid]); - {ose_drv_reply,Port,Ref} -> - Ref - end - catch error:_Error -> - erlang:error(badarg,[Port,Spid]) - end; -attach(Port,Spid) -> - erlang:error(badarg,[Port,Spid]). - - -%%------------------------------------------------------------------------------ -%% @doc Remove attachment to an OSE process. -%% -%% If a message for this monitor has been sent but not received -%% by the calling process, it is removed from the message queue. -%% Note that this only works of the same process -%% that did the attach does the detach. -%% -%% raises: `badarg' -%% -%% @see attach/2 -%% @end -%%------------------------------------------------------------------------------ --spec detach(Port,Ref) -> ok when - Port :: mailbox(), - Ref :: attach_ref(). -detach(Port, {Port,Ref} ) when ?INT_32BIT(Ref) -> - try port_command(Port, <<?DETACH:8, Ref:32>>) of - true -> - receive - {ose_drv_reply,Port,{error,enoent}} -> - %% enoent could mean that it is in the message queue - receive - {mailbox_down,Port,{Port,Ref},_} -> - ok - after 0 -> - ok - end; - {ose_drv_reply,Port,ok} -> - ok - end - catch error:_Error -> - erlang:error(badarg,[Port,{Port,Ref}]) - end; -detach(Port,Ref) -> - erlang:error(badarg,[Port,Ref]). - -%%------------------------------------------------------------------------------ -%% @doc Send an OSE message. -%% -%% The message is sent from the OSE process' own ID that is: `get_id(Port)'. -%% -%% raises: `badarg' -%% -%% @see send/5 -%% @end -%%------------------------------------------------------------------------------ --spec send(Port,Pid,SigNo,SigData) -> ok when - Port :: mailbox(), - Pid :: mailbox_id(), - SigNo :: message_number(), - SigData :: iodata(). -send(Port, Spid, SigNo, SigData) when ?INT_32BIT(Spid), ?INT_32BIT(SigNo) -> - try erlang:port_command(Port, [<<?SEND:8, Spid:32, SigNo:32>>, SigData]) of - true -> ok - catch error:_Error -> - erlang:error(badarg,[Port,Spid,SigNo,SigData]) - end; -send(Port,Spid,SigNo,SigData) -> - erlang:error(badarg,[Port,Spid,SigNo,SigData]). - - -%%------------------------------------------------------------------------------ -%% @doc Send an OSE message with different sender. -%% -%% As {@link send/4} but the sender will be `SenderPid'. -%% -%% raises: `badarg' -%% -%% @see send/4 -%% @end -%%------------------------------------------------------------------------------ --spec send(Port,Pid,SenderPid,SigNo,SigData) -> ok when - Port :: mailbox(), - Pid :: mailbox_id(), - SenderPid :: mailbox_id(), - SigNo :: message_number(), - SigData :: iodata(). -send(Port, Spid, SenderPid, SigNo, SigData) - when ?INT_32BIT(Spid), ?INT_32BIT(SenderPid), ?INT_32BIT(SigNo) -> - try erlang:port_command(Port, [<<?SEND_W_S:8, Spid:32, SenderPid:32, - SigNo:32>>, SigData]) of - true -> ok - catch error:_Error -> - erlang:error(badarg,[Port,Spid,SenderPid,SigNo,SigData]) - end; -send(Port,Spid,SenderPid,SigNo,SigData) -> - erlang:error(badarg,[Port,Spid,SenderPid,SigNo,SigData]). - -%%------------------------------------------------------------------------------ -%% @doc Start listening for specified OSE signal numbers. -%% -%% The mailbox will send `{message,Port,{FromMboxId,ToMboxId,MsgNo,MsgData}}' -%% to the process that created the mailbox when an OSE message with any -%% of the specified `SigNos' arrives. -%% -%% Repeated calls to listen will replace the current set of signal numbers to -%% listen to. i.e -%% -%% ```1>ose:listen(MsgB,[1234,12345]). -%% ok -%% 2> ose:listen(MsgB,[1234,123456]). -%% ok.''' -%% -%% The above will first listen for signals with numbers 1234 and 12345, and then -%% replace that with only listening to 1234 and 123456. -%% -%% With the current implementation it is not possible to listen to all signal -%% numbers. -%% -%% raises: `badarg' | `enomem' -%% -%% @end -%%------------------------------------------------------------------------------ --spec listen(Port, SigNos) -> ok when - Port :: mailbox(), - SigNos :: list(message_number()). -listen(Port, SigNos) when is_list(SigNos) -> - USSigNos = lists:usort(SigNos), - BinSigNos = try - << <<SigNo:32>> || - SigNo <- USSigNos, - ?INT_32BIT(SigNo) orelse erlang:error(badarg) - >> - catch _:_ -> - erlang:error(badarg,[Port,SigNos]) - end, - try port_command(Port, [?LISTEN, BinSigNos]) of - true -> - receive - {ose_drv_reply,Port,{error,Error}} -> - erlang:error(Error,[Port,SigNos]); - {ose_drv_reply,Port,Else} -> - Else - end - catch error:_Error -> - erlang:error(badarg,[Port,SigNos]) - end; -listen(Port, SigNos) -> - erlang:error(badarg,[Port,SigNos]). - - -%%%============================================================================= -%%% Internal functions -%%%============================================================================= diff --git a/lib/ose/test/Makefile b/lib/ose/test/Makefile deleted file mode 100644 index 7e2080ba38..0000000000 --- a/lib/ose/test/Makefile +++ /dev/null @@ -1,67 +0,0 @@ -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- - -MODULES= \ - ose_SUITE - -ERL_FILES= $(MODULES:%=%.erl) - -TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) - -INSTALL_PROGS= $(TARGET_FILES) - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/ose_test - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- - -ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include \ - -I$(ERL_TOP)/lib/kernel/include - -EBIN = . - -EMAKEFILE=Emakefile -COVERFILE=ose.cover - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -make_emakefile: - $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) $(MODULES) \ - > $(EMAKEFILE) - -tests debug opt: make_emakefile - erl $(ERL_MAKE_FLAGS) -make - -clean: - rm -f $(EMAKEFILE) - rm -f $(TARGET_FILES) - rm -f core - -docs: - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_spec: opt - -release_tests_spec: make_emakefile - $(INSTALL_DIR) "$(RELSYSDIR)" - $(INSTALL_DATA) ose.spec $(EMAKEFILE) \ - $(ERL_FILES) $(COVERFILE) "$(RELSYSDIR)" - chmod -R u+w "$(RELSYSDIR)" - @tar cf - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -) - -release_docs_spec: diff --git a/lib/ose/test/ose.cover b/lib/ose/test/ose.cover deleted file mode 100644 index 7b846cfaf6..0000000000 --- a/lib/ose/test/ose.cover +++ /dev/null @@ -1,2 +0,0 @@ -%% -*- erlang -*- -{incl_app,ose,details}. diff --git a/lib/ose/test/ose.spec b/lib/ose/test/ose.spec deleted file mode 100644 index c897e8cd16..0000000000 --- a/lib/ose/test/ose.spec +++ /dev/null @@ -1 +0,0 @@ -{suites,"../ose_test",all}. diff --git a/lib/ose/test/ose_SUITE.erl b/lib/ose/test/ose_SUITE.erl deleted file mode 100644 index 31d950bd03..0000000000 --- a/lib/ose/test/ose_SUITE.erl +++ /dev/null @@ -1,766 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2013. 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(ose_SUITE). - -%-compile(export_all). - --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]). --export([ - basic/1,stress/1,multi_msg_numbers/1,multi_mailboxes/1, - hunt/1,multi_hunt/1,dehunt/1,multi_dehunt/1, - attach/1,multi_attach/1,detach/1,multi_detach/1, - open_errors/1,close_errors/1,get_id_errors/1,get_name_errors/1, - hunt_errors/1,dehunt_errors/1,attach_errors/1,detach_errors/1, - send_errors/1,send_w_s_errors/1,listen_errors/1 - ]). - --define(INTERFACE,ose). - - -init_per_testcase(_Func, Config) -> - Config. -end_per_testcase(_Func, _Config) -> - ok. - -suite() -> [{timeout,{30,seconds}}]. - -all() -> - [ - basic,stress,multi_msg_numbers,multi_mailboxes, - hunt,multi_hunt,dehunt,multi_dehunt, - attach,multi_attach,detach,multi_detach, - - open_errors,close_errors,get_id_errors,get_name_errors, - hunt_errors,dehunt_errors,attach_errors,detach_errors, - send_errors,send_w_s_errors,listen_errors - ]. - -groups() -> - []. - -init_per_suite(Config) -> - case os:type() of - {ose,_} -> - Config; - _Else -> - {skip,"Only run on OSE"} - end. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - -basic(_Config) -> - - [P1,P2] = multi_open(2,[42]), - P1Id = ?INTERFACE:get_id(P1), - P2Id = ?INTERFACE:get_id(P2), - - ok = ?INTERFACE:send(P2,P1Id,42,<<"ping">>), - receive - {message,P1,V1} -> - {P2Id,P1Id,42,<<"ping">>} = V1, - ?INTERFACE:send(P1,P2Id,42,<<"pong">>); - Else1 -> - ct:fail({got_wrong_message,Else1}) - end, - - receive - {message,P2,V2} -> - {P1Id,P2Id,42,<<"pong">>} = V2; - Else2 -> - ct:fail({got_wrong_message,Else2}) - end, - - ?INTERFACE:close(P1), - ?INTERFACE:close(P2). - -%% Send 1000 messages and see if we can cope and that msg order is preserved -stress(_Config) -> - - Iterations = 1000, - - [P1,P2] = multi_open(2,[42]), - P1Id = ?INTERFACE:get_id(P1), - P2Id = ?INTERFACE:get_id(P2), - - spawn(fun() -> - n(fun(N) -> - Msg = [<<"ping">>|integer_to_list(N)], - ?INTERFACE:send(P2,P1Id,42,Msg) - end,Iterations) - end), - timer:sleep(100), - n(fun(N) -> - receive - {message,P1,Value} -> - Int = integer_to_binary(N), - {P2Id,P1Id,42,<<"ping",Int/binary>>} = Value, - ok; - Else -> - ct:fail({got_wrong_message,Else}) - end - end,Iterations), - - ?INTERFACE:close(P1), - ?INTERFACE:close(P2). - -%% Listen to 1000 different message numbers and send some random messages -multi_msg_numbers(_Config) -> - - Iterations = 100, - - [P1,P2] = multi_open(2,lists:seq(2000,3000)), - P1Id = ?INTERFACE:get_id(P1), - - n(fun(_) -> - Num = random:uniform(1000)+2000, - ?INTERFACE:send(P2,P1Id,Num,<<"ping",(integer_to_binary(Num))/binary>>) - end,Iterations), - - n(fun(_) -> - receive - {message,P1,{_,_,Id,<<"ping",Num/binary>>}} when Id > 2000; - Id =< 3000 -> - Id = binary_to_integer(Num), - ok; - Else -> - ct:fail({got_wrong_message,Else}) - end - end,Iterations), - - ?INTERFACE:close(P1), - ?INTERFACE:close(P2). - - -%% Create 100 mailboxes and send messages to them -multi_mailboxes(_Config) -> - - Mailboxes = 100, - - [P1|MBs] = multi_open(Mailboxes,[42]), - - [?INTERFACE:send(P1,?INTERFACE:get_id(P),42,[<<"ping">>,?INTERFACE:get_name(P,?INTERFACE:get_id(P))]) || P <- MBs], - - [receive - {message,P,Value} -> - Name = ?INTERFACE:get_name(P,?INTERFACE:get_id(P)), - {_,_,42,<<"ping",Name/binary>>} = Value, - ok - end || P <- MBs], - - [?INTERFACE:close(P) || P <- [P1|MBs]], - ok. - -hunt(_Config) -> - [P1,P2] = multi_open(2,[]), - - Ref = ?INTERFACE:hunt(P1,"p2"), - receive - {mailbox_up,P1,Ref,Pid} -> - Pid = ?INTERFACE:get_id(P2), - ?INTERFACE:close(P1), - ?INTERFACE:close(P2); - Else -> - ct:fail({got_wrong_message,Else,Ref}) - end. - -multi_hunt(_Config) -> - - Iterations = 100, - - P = ?INTERFACE:open("p"), - - Refs = [?INTERFACE:hunt(P,"p"++integer_to_list(N))|| N <- lists:seq(1,Iterations)], - - Pids = [begin - Prt = ?INTERFACE:open("p"++integer_to_list(N)), - Pid = ?INTERFACE:get_id(Prt), - ?INTERFACE:close(Prt), - Pid - end || N <- lists:seq(1,Iterations)], - - [receive - {mailbox_up,P,Ref,Pid} -> - ok - after 10 -> - ct:fail({did_not_get,Pid,Ref}) - end || {Pid,Ref} <- lists:zip(Pids,Refs)], - ?INTERFACE:close(P). - - -dehunt(_Config) -> - [P1] = multi_open(1,[]), - Ref = ?INTERFACE:hunt(P1,"p2"), - receive - _Else -> ct:fail({got,_Else}) - after 1000 -> - ok - end, - P2 = ?INTERFACE:open("p2"), - - % Make sure any messages are sent - receive after 10 -> ok end, - - ok = ?INTERFACE:dehunt(P1,Ref), - - % Make sure no messages are received - receive - _Else2 -> ct:fail({got,_Else2}) - after 1000 -> - ?INTERFACE:close(P1), - ?INTERFACE:close(P2) - end. - -%%% -%%% This testcase basically: -%%% spawn 10 processes that in parallel -%%% adds some hunts for different OSE processes -%%% maybe create hunted OSE process -%%% dehunt half of the hunts -%%% create more hunts -%%% if not created create hunted OSE process -%%% veryify that all expected hunt messages are received -%%% verify that all processes exited correctly -%%% -%%% This complex test is done to make sure that the internal handling -%%% of dehunt works as expected. -%%% -multi_dehunt(_Config) -> - [P1] = multi_open(1,[]), - - Scenario = - fun(Iterations) -> - - Hunted = "p"++integer_to_list(Iterations), - %% Start a couple of hunts - Refs = [?INTERFACE:hunt(P1,Hunted) || _ <- lists:seq(1,Iterations)], - - %% We alternate if the process is opened before or after the dehunt - P2O = if Iterations rem 2 == 0 -> - ?INTERFACE:open(Hunted); - true -> - undefined - end, - - %% Remove half of them - {RemRefs,_} = lists:mapfoldl(fun(Ref,Acc) when Acc rem 2 == 0 -> - ok = ?INTERFACE:dehunt(P1,Ref), - {[],Acc+1}; - (Ref,Acc) -> - {Ref,Acc+1} - end,0,Refs), - - %% Add some new ones - NewRefs = [?INTERFACE:hunt(P1,Hunted) - || _ <- lists:seq(1,Iterations div 4)] - ++ lists:flatten(RemRefs), - - P2 = if P2O == undefined -> - ?INTERFACE:open(Hunted); - true -> - P2O - end, - P2Id = ?INTERFACE:get_id(P2), - - %% Receive all the expected ones - lists:foreach(fun(Ref) -> - receive - {mailbox_up,P1,Ref,P2Id} -> - ok - after 1000 -> - io:format("Flush: ~p~n",[flush()]), - io:format("~p~n",[{Iterations,{did_not_get, Ref}}]), - ok = Ref - end - end,NewRefs), - - %% Check that no other have arrived - receive - _Else -> - io:format("Flush: ~p~n",[flush()]), - io:format("~p~n",[{Iterations,{got, _Else}}]), - ok = _Else - after 100 -> - ok - end, - ?INTERFACE:close(P2) - end, - - Self = self(), - - n(fun(N) -> - spawn(fun() -> Self ! - Scenario(N*25) - end), - ok - end,10), - - n(fun(_N) -> - receive ok -> ok - after 60000 -> ct:fail(failed) - end - end,10), - ?INTERFACE:close(P1). - -attach(_Config) -> - [P1,P2] = multi_open(2,[]), - - P2Id = ?INTERFACE:get_id(P2), - Ref = ?INTERFACE:attach(P1,P2Id), - ?INTERFACE:close(P2), - receive - {mailbox_down,P1,Ref,P2Id} -> - ?INTERFACE:close(P1); - _Else -> - ct:fail({got,_Else, {P1,Ref,P2Id}}) - after 1000 -> - ct:fail({did_not_get,P1,Ref,P2Id}) - end. - -multi_attach(_Config) -> - - Iterations = 100, - - [P1|Pids] = multi_open(Iterations,[]), - - Refs = [{?INTERFACE:get_id(Pid),?INTERFACE:attach(P1,?INTERFACE:get_id(Pid))} || Pid <- Pids], - - [?INTERFACE:close(Pid) || Pid <- Pids], - - [receive - {mailbox_down,P1,Ref,Pid} -> - ok - after 10000 -> - ct:fail({did_not_get,Pid,Ref}) - end || {Pid,Ref} <- Refs], - ?INTERFACE:close(P1). - -detach(_Config) -> - [P1,P2] = multi_open(2,[]), - P2Id = ?INTERFACE:get_id(P2), - Ref = ?INTERFACE:attach(P1,P2Id), - receive - _Else -> ct:fail({got,_Else}) - after 100 -> - ok - end, - - ?INTERFACE:close(P2), - - % Make sure any messages are sent - receive after 10 -> ok end, - - ?INTERFACE:detach(P1,Ref), - - % Make sure no messages are received - receive - _Else2 -> ct:fail({got,_Else2}) - after 1000 -> - ?INTERFACE:close(P1) - end. - -%%% -%%% This testcase basically: -%%% spawn 10 processes that in parallel -%%% adds some attach for different OSE processes -%%% maybe close OSE process -%%% dehunt half of the hunts -%%% create more hunts -%%% if not closed close attached OSE process -%%% veryify that all expected attach messages are received -%%% verify that all processes exited correctly -%%% -%%% This complex test is done to make sure that the internal handling -%%% of dehunt works as expected. -%%% -multi_detach(_Config) -> - [P1] = multi_open(1,[]), - - Scenario = - fun(Iterations) -> - - Attached = ?INTERFACE:open("p"++integer_to_list(Iterations)), - AttachedId = ?INTERFACE:get_id(Attached), - %% Start a couple of attachs - Refs = [?INTERFACE:attach(P1,AttachedId) || _ <- lists:seq(1,Iterations)], - - %% We alternate if the process is closed before or after the detach - P2O = if Iterations rem 2 == 0 -> - ?INTERFACE:close(Attached); - true -> - undefined - end, - - %% Remove half of them - {RemRefs,_} = lists:mapfoldl(fun(Ref,Acc) when Acc rem 2 == 0 -> - ok = ?INTERFACE:detach(P1,Ref), - {[],Acc+1}; - (Ref,Acc) -> - {Ref,Acc+1} - end,0,Refs), - - %% Add some new ones - NewRefs = [?INTERFACE:attach(P1,AttachedId) - || _ <- lists:seq(1,Iterations div 4)] - ++ lists:flatten(RemRefs), - - if P2O == undefined -> - ?INTERFACE:close(Attached); - true -> - P2O - end, - - %% Receive all the expected ones - lists:foreach(fun(Ref) -> - receive - {mailbox_down,P1,Ref,AttachedId} -> - ok - after 1000 -> - io:format("Flush: ~p~n",[flush()]), - io:format("~p~n",[{Iterations,{did_not_get, Ref}}]), - ok = Ref - end - end,NewRefs), - - %% Check that no other have arrived - receive - _Else -> - io:format("Flush: ~p~n",[flush()]), - io:format("~p~n",[{Iterations,{got, _Else}}]), - ok = _Else - after 100 -> - ok - end - end, - - Self = self(), - - n(fun(N) -> - spawn(fun() -> Self ! - Scenario(N*5) - end), - ok - end,10), - - n(fun(_N) -> - receive ok -> ok - after 60000 -> ct:fail(failed) - end - end,10), - ?INTERFACE:close(P1). - - -open_errors(_Config) -> - {'EXIT',{badarg,[{?INTERFACE,open,[inval],_}|_]}} = - (catch ?INTERFACE:open(inval)), - {'EXIT',{badarg,[{?INTERFACE,open,[["p"|1]],_}|_]}} = - (catch ?INTERFACE:open(["p"|1])), - {'EXIT',{badarg,[{?INTERFACE,open,[["p",1234]],_}|_]}} = - (catch ?INTERFACE:open(["p",1234])), - - ok. - -close_errors(_Config) -> - {'EXIT',{badarg,[{?INTERFACE,close,[inval],_}|_]}} = - (catch ?INTERFACE:close(inval)), - - P1 = ?INTERFACE:open("p1"), - ok = ?INTERFACE:close(P1), - ok = ?INTERFACE:close(P1). - - -get_id_errors(_Config) -> - {'EXIT',{badarg,[{?INTERFACE,get_id,[inval],_}|_]}} = - (catch ?INTERFACE:get_id(inval)), - - P1 = ?INTERFACE:open("p1"), - ok = ?INTERFACE:close(P1), - {'EXIT',{badarg,[{?INTERFACE,get_id,[P1],_}|_]}} = - (catch ?INTERFACE:get_id(P1)), - - ok. - -get_name_errors(_Config) -> - P1 = ?INTERFACE:open("p1"), - {'EXIT',{badarg,[{?INTERFACE,get_name,[P1,inval],_}|_]}} = - (catch ?INTERFACE:get_name(P1,inval)), - - undefined = ?INTERFACE:get_name(P1,1234), - - P2 = ?INTERFACE:open("p2"), - P2Id = ?INTERFACE:get_id(P2), - ok = ?INTERFACE:close(P1), - {'EXIT',{badarg,[{?INTERFACE,get_name,[P1,P2Id],_}|_]}} = - (catch ?INTERFACE:get_name(P1,P2Id)), - ?INTERFACE:close(P2), - - P3 = ?INTERFACE:open([255]), - <<255>> = ?INTERFACE:get_name(P3, ?INTERFACE:get_id(P3)), - ?INTERFACE:close(P3), - - ok. - -hunt_errors(_Config) -> - - {'EXIT',{badarg,[{?INTERFACE,hunt,[inval,"hello"],_}|_]}} = - (catch ?INTERFACE:hunt(inval,"hello")), - - P1 = ?INTERFACE:open("p1"), - {'EXIT',{badarg,[{?INTERFACE,hunt,[P1,["hello",12345]],_}|_]}} = - (catch ?INTERFACE:hunt(P1,["hello",12345])), - - P2 = ?INTERFACE:open(<<255>>), - P2Pid = ?INTERFACE:get_id(P2), - Ref = ?INTERFACE:hunt(P1,[255]), - receive - {mailbox_up,P1,Ref,P2Pid} -> - ok; - Else -> - ct:fail({got,Else,{mailbox_up,P1,Ref,P2Pid}}) - after 150 -> - ct:fail({did_not_get,{mailbox_up,P1,Ref,P2Pid}}) - end, - - ok = ?INTERFACE:close(P1), - ok = ?INTERFACE:close(P2), - {'EXIT',{badarg,[{?INTERFACE,hunt,[P1,["hello"]],_}|_]}} = - (catch ?INTERFACE:hunt(P1,["hello"])), - - ok. - -dehunt_errors(_Config) -> - P1 = ?INTERFACE:open("p1"), - Ref = ?INTERFACE:hunt(P1,"p2"), - - {'EXIT',{badarg,[{?INTERFACE,dehunt,[inval,Ref],_}|_]}} = - (catch ?INTERFACE:dehunt(inval,Ref)), - - {'EXIT',{badarg,[{?INTERFACE,dehunt,[P1,inval],_}|_]}} = - (catch ?INTERFACE:dehunt(P1,inval)), - - ok = ?INTERFACE:dehunt(P1,Ref), - ok = ?INTERFACE:dehunt(P1,Ref), - - ok = ?INTERFACE:close(P1), - - {'EXIT',{badarg,[{?INTERFACE,dehunt,[P1,Ref],_}|_]}} = - (catch ?INTERFACE:dehunt(P1,Ref)), - - case ?INTERFACE of - ose -> ok; - _ -> - P2 = ?INTERFACE:open("p2"), - ok = ?INTERFACE:close(P2) - end, - - receive - Else -> ct:fail({got,Else}) - after 100 -> - ok - end. - -attach_errors(_Config) -> - P1 = ?INTERFACE:open("p1"), - P2 = ?INTERFACE:open("p2"), - P2Id = ?INTERFACE:get_id(P2), - - {'EXIT',{badarg,[{?INTERFACE,attach,[inval,P2Id],_}|_]}} = - (catch ?INTERFACE:attach(inval,P2Id)), - - {'EXIT',{badarg,[{?INTERFACE,attach,[P1,[12345]],_}|_]}} = - (catch ?INTERFACE:attach(P1,[12345])), - - ok = ?INTERFACE:close(P1), - ok = ?INTERFACE:close(P2), - {'EXIT',{badarg,[{?INTERFACE,attach,[P1,P2Id],_}|_]}} = - (catch ?INTERFACE:attach(P1,P2Id)), - - ok. - -detach_errors(_Config) -> - P1 = ?INTERFACE:open("p1"), - P2 = ?INTERFACE:open("p2"), - P2Id = ?INTERFACE:get_id(P2), - - Ref = ?INTERFACE:attach(P1,P2Id), - - {'EXIT',{badarg,[{?INTERFACE,detach,[inval,Ref],_}|_]}} = - (catch ?INTERFACE:detach(inval,Ref)), - - {'EXIT',{badarg,[{?INTERFACE,detach,[P1,inval],_}|_]}} = - (catch ?INTERFACE:detach(P1,inval)), - - ok = ?INTERFACE:detach(P1,Ref), - ok = ?INTERFACE:detach(P1,Ref), - - case ?INTERFACE of - ose -> ok; - _ -> - ok = ?INTERFACE:close(P1) - end, - - ok = ?INTERFACE:close(P2), - ok = ?INTERFACE:close(P1), - - {'EXIT',{badarg,[{?INTERFACE,detach,[P1,Ref],_}|_]}} = - (catch ?INTERFACE:detach(P1,Ref)), - - receive - Else -> ct:fail({got,Else}) - after 100 -> - ok - end. - -send_errors(_Config) -> - P1 = ?INTERFACE:open("p1"), - P2 = ?INTERFACE:open("p2"), - P2Id = ?INTERFACE:get_id(P2), - - {'EXIT',{badarg,[{?INTERFACE,send,[inval,P2Id,42,"hello"],_}|_]}} = - (catch ?INTERFACE:send(inval,P2Id,42,"hello")), - {'EXIT',{badarg,[{?INTERFACE,send,[P1,inval,42,"hello"],_}|_]}} = - (catch ?INTERFACE:send(P1,inval,42,"hello")), - {'EXIT',{badarg,[{?INTERFACE,send,[P1,P2Id,inval,"hello"],_}|_]}} = - (catch ?INTERFACE:send(P1,P2Id,inval,"hello")), - {'EXIT',{badarg,[{?INTERFACE,send,[P1,P2Id,42,inval],_}|_]}} = - (catch ?INTERFACE:send(P1,P2Id,42,inval)), - - ok = ?INTERFACE:close(P2), - ok = ?INTERFACE:send(P1,P2Id,42,"hello"), - ok = ?INTERFACE:close(P1), - - {'EXIT',{badarg,[{?INTERFACE,send,[P1,P2Id,42,"hello"],_}|_]}} = - (catch ?INTERFACE:send(P1,P2Id,42,"hello")), - - receive - Else -> ct:fail({got,Else}) - after 100 -> - ok - end. - -send_w_s_errors(_Config) -> - P1 = ?INTERFACE:open("p1"), - P1Id = ?INTERFACE:get_id(P1), - P2 = ?INTERFACE:open("p2"), - P2Id = ?INTERFACE:get_id(P2), - P3 = ?INTERFACE:open("p3"), - P3Id = ?INTERFACE:get_id(P3), - - {'EXIT',{badarg,[{?INTERFACE,send,[inval,P2Id,P1Id,42,"hello"],_}|_]}} = - (catch ?INTERFACE:send(inval,P2Id,P1Id,42,"hello")), - {'EXIT',{badarg,[{?INTERFACE,send,[P2,-1,P1Id,42,"hello"],_}|_]}} = - (catch ?INTERFACE:send(P2,-1,P1Id,42,"hello")), - {'EXIT',{badarg,[{?INTERFACE,send,[P2,P2Id,1 bsl 32,42,"hello"],_}|_]}} = - (catch ?INTERFACE:send(P2,P2Id,1 bsl 32,42,"hello")), - {'EXIT',{badarg,[{?INTERFACE,send,[P2,P2Id,P1Id,inval,"hello"],_}|_]}} = - (catch ?INTERFACE:send(P2,P2Id,P1Id,inval,"hello")), - {'EXIT',{badarg,[{?INTERFACE,send,[P2,P2Id,P1Id,42,inval],_}|_]}} = - (catch ?INTERFACE:send(P2,P2Id,P1Id,42,inval)), - - ok = ?INTERFACE:close(P3), - ok = ?INTERFACE:send(P2,P3Id,P1Id,42,"hello"), - - ok = ?INTERFACE:close(P1), - ok = ?INTERFACE:send(P2,P2Id,P1Id,42,"hello"), - ok = ?INTERFACE:close(P2), - - {'EXIT',{badarg,[{?INTERFACE,send,[P1,P2Id,P1Id,42,"hello"],_}|_]}} = - (catch ?INTERFACE:send(P1,P2Id,P1Id,42,"hello")), - - receive - Else -> ct:fail({got,Else}) - after 100 -> - ok - end. - -listen_errors(_Config) -> - - P1 = ?INTERFACE:open("p1"), - P1Id = ?INTERFACE:get_id(P1), - - {'EXIT',{badarg,[{?INTERFACE,listen,[inval,[42]],_}|_]}} = - (catch ?INTERFACE:listen(inval,[42])), - {'EXIT',{badarg,[{?INTERFACE,listen,[P1,inval],_}|_]}} = - (catch ?INTERFACE:listen(P1,inval)), - {'EXIT',{badarg,[{?INTERFACE,listen,[P1,[1 bsl 33]],_}|_]}} = - (catch ?INTERFACE:listen(P1,[1 bsl 33])), - - ok = ?INTERFACE:listen(P1,[42,42,42,42,42,42,42,42,42,42,42,42,42]), - - case ?INTERFACE of - ose -> ok; - _ -> - ?INTERFACE:send(P1,P1Id,42,"hello"), - timer:sleep(50), - ?INTERFACE:listen(P1,[]), - ?INTERFACE:send(P1,P1Id,42,"hello2"), - - receive - {message,P1,42,"hello"} -> ok - end, - - receive - Else -> ct:fail({got,Else}) - after 100 -> - ok - end - end, - - ok = ?INTERFACE:close(P1), - {'EXIT',{badarg,[{?INTERFACE,listen,[P1,[42]],_}|_]}} = - (catch ?INTERFACE:listen(P1,[42])), - - ok. - -%% -%% Internal functions -%% -multi_open(N,ListenNums) -> - multi_open(N,ListenNums,[]). - -multi_open(0,_,Acc) -> - Acc; -multi_open(N,ListenNums,Acc) -> - P = ?INTERFACE:open("p"++integer_to_list(N)), - ok = ?INTERFACE:listen(P,ListenNums), - multi_open(N-1,ListenNums,[P|Acc]). - -n(_F,0) -> - ok; -n(F,N) -> - ok = F(N), - n(F,N-1). - - -flush() -> - receive - Msg -> - [Msg|flush()] - after 0 -> - [] - end. diff --git a/lib/ose/vsn.mk b/lib/ose/vsn.mk deleted file mode 100644 index fb1cf8219f..0000000000 --- a/lib/ose/vsn.mk +++ /dev/null @@ -1 +0,0 @@ -OSE_VSN = 1.1 diff --git a/lib/otp_mibs/test/Makefile b/lib/otp_mibs/test/Makefile index e1cfbb347d..18d7e915db 100644 --- a/lib/otp_mibs/test/Makefile +++ b/lib/otp_mibs/test/Makefile @@ -49,7 +49,6 @@ RELSYSDIR = $(RELEASE_PATH)/otp_mibs_test # ---------------------------------------------------- ERL_MAKE_FLAGS += ERL_COMPILE_FLAGS += \ - -I$(ERL_TOP)/lib/test_server/include \ -I$(ERL_TOP)/lib/snmp/include # ---------------------------------------------------- diff --git a/lib/otp_mibs/test/otp_mibs_SUITE.erl b/lib/otp_mibs/test/otp_mibs_SUITE.erl index abb5aa8194..4d1eb155cd 100644 --- a/lib/otp_mibs/test/otp_mibs_SUITE.erl +++ b/lib/otp_mibs/test/otp_mibs_SUITE.erl @@ -30,7 +30,7 @@ %% > ct_run -suite otp_mibs_SUITE -config otp_mibs_SUITE.cfg %%----------------------------------------------------------------- --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("otp_mibs/include/OTP-MIB.hrl"). -include_lib("snmp/include/snmp_types.hrl"). diff --git a/lib/parsetools/test/Makefile b/lib/parsetools/test/Makefile index f84bb0e75e..75f9624fd5 100644 --- a/lib/parsetools/test/Makefile +++ b/lib/parsetools/test/Makefile @@ -41,7 +41,7 @@ RELSYSDIR = $(RELEASE_PATH)/parsetools_test # FLAGS # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +ERL_COMPILE_FLAGS += EBIN = . diff --git a/lib/parsetools/test/leex_SUITE.erl b/lib/parsetools/test/leex_SUITE.erl index 1e3738de85..f5ff32c358 100644 --- a/lib/parsetools/test/leex_SUITE.erl +++ b/lib/parsetools/test/leex_SUITE.erl @@ -31,7 +31,7 @@ -define(privdir, "leex_SUITE_priv"). -define(t, test_server). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(datadir, ?config(data_dir, Config)). -define(privdir, ?config(priv_dir, Config)). -endif. diff --git a/lib/parsetools/test/yecc_SUITE.erl b/lib/parsetools/test/yecc_SUITE.erl index 6603a5a07d..a1bb5eb16c 100644 --- a/lib/parsetools/test/yecc_SUITE.erl +++ b/lib/parsetools/test/yecc_SUITE.erl @@ -30,7 +30,7 @@ -define(privdir, "yecc_SUITE_priv"). -define(t, test_server). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(datadir, ?config(data_dir, Config)). -define(privdir, ?config(priv_dir, Config)). -endif. diff --git a/lib/percept/test/Makefile b/lib/percept/test/Makefile index 4ba0b80fc8..6891de832d 100644 --- a/lib/percept/test/Makefile +++ b/lib/percept/test/Makefile @@ -52,8 +52,7 @@ RELSYSDIR = $(RELEASE_PATH)/percept_test # FLAGS # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include \ - -I$(ERL_TOP)/lib/percept/include +ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/percept/include # ---------------------------------------------------- # Targets diff --git a/lib/percept/test/egd_SUITE.erl b/lib/percept/test/egd_SUITE.erl index 41e8999e17..0b1149e1f1 100644 --- a/lib/percept/test/egd_SUITE.erl +++ b/lib/percept/test/egd_SUITE.erl @@ -19,7 +19,7 @@ %% -module(egd_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Test server specific exports -export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2]). @@ -40,7 +40,7 @@ -define(default_timeout, ?t:minutes(1)). init_per_suite(Config) when is_list(Config) -> - random:seed(now()), + rand:seed(exsplus), Config. end_per_suite(Config) when is_list(Config) -> @@ -348,4 +348,4 @@ get_points(0, Out) -> get_points(N, Out) -> get_points(N - 1, [get_point() | Out]). -random(N) -> trunc(random:uniform(trunc(N + 1)) - 1). +random(N) -> trunc(rand:uniform(trunc(N + 1)) - 1). diff --git a/lib/percept/test/percept_SUITE.erl b/lib/percept/test/percept_SUITE.erl index fd96c2b97a..06d62630ba 100644 --- a/lib/percept/test/percept_SUITE.erl +++ b/lib/percept/test/percept_SUITE.erl @@ -19,7 +19,7 @@ %% -module(percept_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Test server specific exports -export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2]). diff --git a/lib/percept/test/percept_db_SUITE.erl b/lib/percept/test/percept_db_SUITE.erl index e2775aabc0..5b878e8462 100644 --- a/lib/percept/test/percept_db_SUITE.erl +++ b/lib/percept/test/percept_db_SUITE.erl @@ -19,7 +19,7 @@ %% -module(percept_db_SUITE). --include("test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Test server specific exports -export([all/1]). diff --git a/lib/public_key/doc/src/public_key.xml b/lib/public_key/doc/src/public_key.xml index 258e7cd1b9..16a7497a22 100644 --- a/lib/public_key/doc/src/public_key.xml +++ b/lib/public_key/doc/src/public_key.xml @@ -114,8 +114,8 @@ </item> <tag><c>pem_entry () =</c></tag> - <item><p><c>{pki_asn1_type(), binary(), %% DER or encrypted DER not_encrypted</c></p> - <p><c>| cipher_info()}</c></p></item> + <item><p><c>{pki_asn1_type(), binary(), %% DER or encrypted DER</c></p> + <p><c> not_encrypted | cipher_info()}</c></p></item> <tag><c>cipher_info() = </c></tag> <item><p><c>{"RC2-CBC" | "DES-CBC" | "DES-EDE3-CBC", crypto:rand_bytes(8)</c></p> @@ -786,13 +786,13 @@ fun(#'DistributionPoint'{}, #'CertificateList'{}, <fsummary>Decodes an SSH file-binary.</fsummary> <type> <v>SshBin = binary()</v> - <d>Example {ok, SshBin} = file:read_file("known_hosts").</d> + <d>Example <c>{ok, SshBin} = file:read_file("known_hosts")</c>.</d> <v>Type = public_key | ssh_file()</v> <d>If <c>Type</c> is <c>public_key</c> the binary can be either an RFC4716 public key or an OpenSSH public key.</d> </type> <desc> - <p>Decodes an SSH file-binary. In the case of <c>know_hosts</c> or + <p>Decodes an SSH file-binary. In the case of <c>known_hosts</c> or <c>auth_keys</c>, the binary can include one or more lines of the file. Returns a list of public keys and their attributes, possible attribute values depends on the file type represented by the @@ -842,7 +842,7 @@ fun(#'DistributionPoint'{}, #'CertificateList'{}, <v>Key = rsa_public_key() | dsa_public_key() | ec_public_key()</v> </type> <desc> - <p>Veryfies a digital signature.</p> + <p>Verifies a digital signature.</p> </desc> </func> diff --git a/lib/public_key/doc/src/public_key_records.xml b/lib/public_key/doc/src/public_key_records.xml index fb03da3150..d34f3ed9a3 100644 --- a/lib/public_key/doc/src/public_key_records.xml +++ b/lib/public_key/doc/src/public_key_records.xml @@ -57,9 +57,9 @@ <taglist> <tag><c>time() =</c></tag> - <item><p><c>uct_time() | general_time()</c></p></item> + <item><p><c>utc_time() | general_time()</c></p></item> - <tag><c>uct_time() =</c></tag> + <tag><c>utc_time() =</c></tag> <item><p><c>{utcTime, "YYMMDDHHMMSSZ"}</c></p></item> <tag><c>general_time() =</c></tag> @@ -144,7 +144,7 @@ <section> <title>DSA</title> - <p>Erlang representation of <url href="http://www.ietf.org/rfc/rfc6979.txt">Digigital Signature Algorithm (DSA)</url> keys</p> + <p>Erlang representation of <url href="http://www.ietf.org/rfc/rfc6979.txt">Digital Signature Algorithm (DSA)</url> keys</p> <code> #'DSAPrivateKey',{ version, % integer() diff --git a/lib/reltool/src/reltool.hrl b/lib/reltool/src/reltool.hrl index 4c3f76bdc6..9ac22b9450 100644 --- a/lib/reltool/src/reltool.hrl +++ b/lib/reltool/src/reltool.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2012. All Rights Reserved. +%% Copyright Ericsson AB 2009-2015. 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. @@ -141,15 +141,15 @@ app_name :: '_' | app_name(), incl_cond :: '_' | incl_cond() | undefined, debug_info :: '_' | debug_info() | undefined, - is_app_mod :: '_' | boolean(), - is_ebin_mod :: '_' | boolean(), - uses_mods :: '$2' | [mod_name()], - exists :: '_' | boolean(), + is_app_mod :: '_' | boolean() | undefined, + is_ebin_mod :: '_' | boolean() | undefined, + uses_mods :: '$2' | [mod_name()] | undefined, + exists :: '_' | boolean() | undefined, %% Dynamic - status :: '_' | status(), - used_by_mods :: '_' | [mod_name()], - is_pre_included :: '_' | boolean() | undefined, - is_included :: '_' | boolean() | undefined + status = ok :: '_' | status(), + used_by_mods = [] :: '_' | [mod_name()], + is_pre_included :: '_' | boolean() | undefined, + is_included :: '_' | boolean() | undefined }). -record(app_info, @@ -177,10 +177,10 @@ name :: '_' | app_name(), is_escript :: '_' | boolean() | {inlined, escript_app_name()}, use_selected_vsn :: '_' | vsn | dir | undefined, - active_dir :: '_' | dir(), + active_dir :: '_' | dir() | undefined, sorted_dirs :: '_' | [dir()], - vsn :: '_' | app_vsn(), - label :: '_' | app_label(), + vsn :: '_' | app_vsn() | undefined, + label :: '_' | app_label() | undefined, info :: '_' | #app_info{} | undefined, mods :: '_' | [#mod{}], @@ -192,21 +192,21 @@ debug_info :: '_' | debug_info() | undefined, app_file :: '_' | app_file() | undefined, app_type :: '_' | app_type() | undefined, - incl_app_filters :: '_' | [#regexp{}], - excl_app_filters :: '_' | [#regexp{}], - incl_archive_filters :: '_' | [#regexp{}], - excl_archive_filters :: '_' | [#regexp{}], - archive_opts :: '_' | [archive_opt()], + incl_app_filters :: '_' | [#regexp{}] | undefined, + excl_app_filters :: '_' | [#regexp{}] | undefined, + incl_archive_filters :: '_' | [#regexp{}] | undefined, + excl_archive_filters :: '_' | [#regexp{}] | undefined, + archive_opts :: '_' | [archive_opt()] | undefined, %% Dynamic status :: '_' | status(), - uses_mods :: '_' | [mod_name()], - used_by_mods :: '_' | [mod_name()], - uses_apps :: '_' | [app_name()], - used_by_apps :: '_' | [app_name()], + uses_mods :: '_' | [mod_name()] | undefined, + used_by_mods :: '_' | [mod_name()] | undefined, + uses_apps :: '_' | [app_name()] | undefined, + used_by_apps :: '_' | [app_name()] | undefined, is_pre_included :: '_' | '$2' | boolean() | undefined, is_included :: '_' | '$1' | boolean() | undefined, - rels :: '_' | [rel_name()] + rels :: '_' | [rel_name()] | undefined }). -record(rel_app, @@ -237,7 +237,7 @@ rels :: [#rel{}], emu_name :: emu_name(), profile :: profile(), - excl_lib :: excl_lib(), + excl_lib :: excl_lib() | undefined, incl_sys_filters :: [#regexp{}], excl_sys_filters :: [#regexp{}], incl_app_filters :: [#regexp{}], diff --git a/lib/reltool/src/reltool_fgraph_win.erl b/lib/reltool/src/reltool_fgraph_win.erl index 6b58cae187..deab502bfe 100644 --- a/lib/reltool/src/reltool_fgraph_win.erl +++ b/lib/reltool/src/reltool_fgraph_win.erl @@ -220,8 +220,8 @@ graph_add_node_unsure(Key, State, G = #graph{ vs = Vs }) -> graph_add_node(Key, Color, G = #graph{ vs = Vs}) -> Q = 20.0, % repulsive force M = 0.5, % mass - P = {float(450 + random:uniform(100)), - float(450 + random:uniform(100))}, + P = {float(450 + rand:uniform(100)), + float(450 + rand:uniform(100))}, G#graph{ vs = reltool_fgraph:add(Key, #fg_v{ p = P, m = M, q = Q, color = Color}, Vs)}. diff --git a/lib/runtime_tools/c_src/Makefile.in b/lib/runtime_tools/c_src/Makefile.in index 448b8c62c2..aeacee0655 100644 --- a/lib/runtime_tools/c_src/Makefile.in +++ b/lib/runtime_tools/c_src/Makefile.in @@ -102,12 +102,7 @@ endif _create_dirs := $(shell mkdir -p $(OBJDIR) $(LIBDIR)) -ifneq ($(findstring ose,$(TARGET)),ose) debug opt valgrind: $(SOLIBS) $(OBJDIR) $(LIBDIR) $(NIF_LIB) -else -# We do not build this on OSE -debug opt valgrind: -endif DYNTRACE_OBJS = $(before_DTrace_OBJS) @@ -159,10 +154,8 @@ include $(ERL_TOP)/make/otp_release_targets.mk release_spec: opt $(INSTALL_DIR) "$(RELSYSDIR)/priv/obj" $(INSTALL_DIR) "$(RELSYSDIR)/priv/lib" -ifneq ($(findstring ose,$(TARGET)),ose) $(INSTALL_PROGRAM) $(DYNTRACE_OBJS) "$(RELSYSDIR)/priv/obj" $(INSTALL_PROGRAM) $(NIF_LIB) $(SOLIBS) "$(RELSYSDIR)/priv/lib" -endif release_docs_spec: diff --git a/lib/runtime_tools/doc/src/Makefile b/lib/runtime_tools/doc/src/Makefile index 0292333f0a..38725807ae 100644 --- a/lib/runtime_tools/doc/src/Makefile +++ b/lib/runtime_tools/doc/src/Makefile @@ -41,7 +41,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) # Target Specs # ---------------------------------------------------- XML_APPLICATION_FILES = ref_man.xml -XML_REF3_FILES = dbg.xml dyntrace.xml erts_alloc_config.xml system_information.xml +XML_REF3_FILES = dbg.xml dyntrace.xml erts_alloc_config.xml system_information.xml msacc.xml XML_REF6_FILES = runtime_tools_app.xml XML_PART_FILES = part_notes.xml part_notes_history.xml part.xml diff --git a/lib/runtime_tools/doc/src/msacc.xml b/lib/runtime_tools/doc/src/msacc.xml new file mode 100644 index 0000000000..129da3d230 --- /dev/null +++ b/lib/runtime_tools/doc/src/msacc.xml @@ -0,0 +1,305 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE erlref SYSTEM "erlref.dtd"> + +<erlref> + <header> + <copyright> + <year>2014</year><year>2014</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>Microstate Accounting</title> + <prepared>Lukas Larsson</prepared> + <responsible></responsible> + <docno>1</docno> + <approved></approved> + <checked></checked> + <date>14-09-30</date> + <rev>A</rev> + <file>msacc.xml</file> + </header> + <module>msacc</module> + <modulesummary>Convenience functions for microstate accounting</modulesummary> + <description> + <p>This module implements some convenience functions for analyzing + microstate accounting data. For details about how to use the basic api and + what the different states represent see + <seealso marker="erts:erlang#statistics_microstate_accounting"><c> + erlang:statistics(microstate_accounting)</c></seealso>.</p> + <marker id="msacc_print_example"></marker> + <p><em>Basic Scenario</em></p> + <pre>1> <input>msacc:start(1000).</input> +ok +2> <input>msacc:print().</input> +Average thread real-time : 1000513 us +Accumulated system run-time : 2213 us +Average scheduler run-time : 1076 us + + Thread aux check_io emulator gc other port sleep + +Stats per thread: + async( 0) 0.00% 0.00% 0.00% 0.00% 0.00% 0.00% 100.00% + async( 1) 0.00% 0.00% 0.00% 0.00% 0.00% 0.00% 100.00% + aux( 1) 0.00% 0.00% 0.00% 0.00% 0.00% 0.00% 99.99% + scheduler( 1) 0.00% 0.03% 0.13% 0.00% 0.01% 0.00% 99.82% + scheduler( 2) 0.00% 0.00% 0.00% 0.00% 0.03% 0.00% 99.97% + +Stats per type: + async 0.00% 0.00% 0.00% 0.00% 0.00% 0.00% 100.00% + aux 0.00% 0.00% 0.00% 0.00% 0.00% 0.00% 99.99% + scheduler 0.00% 0.02% 0.06% 0.00% 0.02% 0.00% 99.89% +ok +</pre> + <p>This first command enables microstate accounting for 1000 milliseconds. + See <seealso marker="#start-0"><c>start/0</c></seealso>, + <seealso marker="#stop-0"><c>stop/0</c></seealso>, + <seealso marker="#reset-0"><c>reset/0</c></seealso> and + <seealso marker="#start-1"><c>start/1</c></seealso> for more details. + The second command prints the statistics gathered during that time. + First three general statistics are printed.</p> + <taglist> + <tag>Average real-time</tag> + <item>The average time spent collecting data in the threads. + This should be close to the time which data was collected. + </item> + <tag>System run-time</tag> + <item>The total run-time of all threads in the system. + This is what you get if you call <c>msacc:stats(total_runtime,Stats).</c> + </item> + <tag>Average scheduler run-time</tag> + <item>The average run-time for the schedulers. + This is the average amount of time the schedulers did not sleep.</item> + </taglist> + <p>Then one column per state is printed with a the percentage of time this + thread spent in the state out of it's own real-time. After the thread + specific time, the accumulated time for each type of thread is printed in + a similar format.</p> + <p>Since we have the average real-time and the percentage spent in each + state we can easily calculate the time spent in each state by multiplying + <c>Average thread real-time</c> with <c>Thread state %</c>, i.e. to + get the time Scheduler 1 spent in the emulator state we do + <c>1000513us * 0.13% = 1300us</c>.</p> + </description> + <datatypes> + <datatype> + <name name="msacc_data"/> + </datatype> + <datatype> + <name name="msacc_data_thread"/> + </datatype> + <datatype> + <name name="msacc_data_counters"/> + <desc><p>A map containing the different microstate accounting states and + the number of microseconds spent in it.</p></desc> + </datatype> + <datatype> + <name name="msacc_stats"/> + </datatype> + <datatype> + <name name="msacc_stats_thread"/> + <desc><p>A map containing information about a specific thread. The + percentages in the map can be either run-time or real-time depending + on if <c>runtime</c> or <c>realtime</c> was requested from + <seealso marker="#stats-2">stats/2</seealso>. <c>system</c> is the + percentage of total system time for this specific thread.</p></desc> + </datatype> + <datatype> + <name name="msacc_stats_counters"/> + <desc><p>A map containing the different microstate accounting states. Each + value in the map contains another map with the percentage of time that + this thread has spent in the specific state. Both the percentage of + <c>system</c> time and the time for that specific <c>thread</c> is part of + the map.</p></desc> + </datatype> + <datatype> + <name name="msacc_type"/> + </datatype> + <datatype> + <name name="msacc_id"/> + </datatype> + <datatype> + <name name="msacc_state"/> + <desc><p>The different states that a thread can be in. See + <seealso marker="erts:erlang#statistics_microstate_accounting"> + erlang:statistics(microstate_accounting)</seealso> for details. + </p></desc> + </datatype> + <datatype> + <name name="msacc_print_options"/> + <desc><p>The different options that can be given to + <seealso marker="#print-2"><c>print/2</c></seealso>. + </p></desc> + </datatype> + </datatypes> + <funcs> + <func> + <name name="available" arity="0"/> + <fsummary>Check if microstate accounting is available</fsummary> + <desc> + <p>This function checks whether microstate accounting + is available or not.</p> + </desc> + </func> + <func> + <name name="start" arity="0"/> + <fsummary>Start microstate accounting.</fsummary> + <desc> + <p>Start microstate accounting. Returns whether it was + previously enabled or disabled.</p> + </desc> + </func> + <func> + <name name="start" arity="1"/> + <fsummary>Start microstate accounting for a time.</fsummary> + <desc> + <p>Resets all counters and then starts microstate accounting + for the given milliseconds.</p> + </desc> + </func> + <func> + <name name="stop" arity="0"/> + <fsummary>Stop microstate accounting.</fsummary> + <desc> + <p>Stop microstate accounting. + Returns whether is was previously enabled or disabled.</p> + </desc> + </func> + <func> + <name name="reset" arity="0"/> + <fsummary>Reset microstate accounting counters</fsummary> + <desc> + <p>Reset microstate accounting counters. + Returns whether is was enabled or disabled.</p> + </desc> + </func> + <func> + <name name="print" arity="0"/> + <fsummary>Print microstate statistics</fsummary> + <desc> + <p> + Prints the current microstate accounting to standard out. + Same as + <seealso marker="#print-1"> + <c>msacc:print(msacc:stats(),#{}).</c> + </seealso> + </p> + </desc> + </func> + <func> + <name name="print" arity="1"/> + <fsummary>Print microstate statistics</fsummary> + <desc> + <p>Print the given microstate statistics values to stdout. + Same as + <seealso marker="#print-1"> + <c>msacc:print(DataOrStats,#{}).</c> + </seealso> + </p> + </desc> + </func> + <func> + <name name="print" arity="2"/> + <fsummary>Print microstate statistics</fsummary> + <desc> + <p>Print the given microstate statistics values to standard out. + With many states this can be quite verbose. See the top of this + reference manual for a brief description of what the fields mean.</p> + <p>It is possible to print more specific types of statistics by + first manipulating the <c>DataOrStats</c> using + <seealso marker="#stats-2"><c>stats/2</c></seealso>. + For instance if you want to print the percentage of run-time for each + thread you can do:</p> + <pre><input>msacc:print(msacc:stats(runtime,msacc:stats())).</input></pre> + <p>If you want to only print run-time per thread type you can do:</p> + <pre><input>msacc:print(msacc:stats(type,msacc:stats(runtime,msacc:stats()))).</input></pre> + <p><em>Options</em></p> + <taglist> + <tag><c>system</c></tag><item>Print percentage of time spent in each + state out of system time as well as thread time. + Default: false.</item> + </taglist> + </desc> + </func> + <func> + <name name="print" arity="3"/> + <fsummary>Print microstate statistics</fsummary> + <desc> + <p>Print the given microstate statistics values to the given file + or device. The other arguments behave the same way as for + <seealso marker="#print-2"><c>print/2</c></seealso>.</p> + </desc> + </func> + <func> + <name name="stats" arity="0"/> + <fsummary></fsummary> + <desc> + <p>Returns a runtime system independent version of the microstate + statistics data presented by + <seealso marker="erts:erlang#statistics_microstate_accounting"> + <c>erlang:statistics(microstate_accounting)</c></seealso>. + All counters have been normalized to be in microsecond resolution.</p> + </desc> + </func> + <func> + <name name="stats" arity="2" clause_i="1"/> + <fsummary></fsummary> + <desc> + <p>Returns the system time for the given microstate statistics values. + System time is the accumulated time of all threads.</p> + <taglist> + <tag><c>realtime</c></tag> + <item>Returns all time recorded for all threads.</item> + <tag><c>runtime</c></tag> + <item>Returns all time spent doing work for all threads, i.e. + all time not spent in the <c>sleep</c> state.</item> + </taglist> + </desc> + </func> + <func> + <name name="stats" arity="2" clause_i="2"/> + <fsummary></fsummary> + <desc> + <p>Returns fractions of real-time or run-time spent in the various + threads from the given microstate statistics values.</p> + </desc> + </func> + <func> + <name name="stats" arity="2" clause_i="3"/> + <fsummary></fsummary> + <desc> + <p>Returns a list of microstate statistics values where the values + for all threads of the same type has been merged.</p> + </desc> + </func> + <func> + <name name="to_file" arity="1"/> + <fsummary></fsummary> + <desc> + <p>Dumps the current microstate statistics counters to a file that can + be parsed with <seealso marker="kernel:file#consult/1"> + file:consult/1</seealso>.</p> + </desc> + </func> + <func> + <name name="from_file" arity="1"/> + <fsummary></fsummary> + <desc> + <p>Read a file dump produced by <seealso marker="#to_file/1"> + to_file(Filename)</seealso>.</p> + </desc> + </func> + </funcs> +</erlref> diff --git a/lib/runtime_tools/doc/src/ref_man.xml b/lib/runtime_tools/doc/src/ref_man.xml index ea0c0832a4..8657a07a30 100644 --- a/lib/runtime_tools/doc/src/ref_man.xml +++ b/lib/runtime_tools/doc/src/ref_man.xml @@ -36,6 +36,7 @@ <xi:include href="dbg.xml"/> <xi:include href="dyntrace.xml"/> <xi:include href="erts_alloc_config.xml"/> + <xi:include href="msacc.xml"/> <xi:include href="system_information.xml"/> </application> diff --git a/lib/runtime_tools/doc/src/specs.xml b/lib/runtime_tools/doc/src/specs.xml index d4c3c9dfe6..978bd39e55 100644 --- a/lib/runtime_tools/doc/src/specs.xml +++ b/lib/runtime_tools/doc/src/specs.xml @@ -1,4 +1,5 @@ <?xml version="1.0" encoding="utf-8" ?> <specs xmlns:xi="http://www.w3.org/2001/XInclude"> <xi:include href="../specs/specs_system_information.xml"/> + <xi:include href="../specs/specs_msacc.xml"/> </specs> diff --git a/lib/runtime_tools/src/Makefile b/lib/runtime_tools/src/Makefile index 99b90f9ec5..3b41184f4e 100644 --- a/lib/runtime_tools/src/Makefile +++ b/lib/runtime_tools/src/Makefile @@ -45,7 +45,9 @@ MODULES= \ percept_profile \ system_information \ observer_backend \ - ttb_autostart + ttb_autostart\ + msacc + HRL_FILES= ../include/observer_backend.hrl ERL_FILES= $(MODULES:%=%.erl) diff --git a/lib/runtime_tools/src/dbg.erl b/lib/runtime_tools/src/dbg.erl index d2a7d734c1..6eea1a0917 100644 --- a/lib/runtime_tools/src/dbg.erl +++ b/lib/runtime_tools/src/dbg.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. 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. @@ -1269,13 +1269,15 @@ gen_reader(follow_file, Filename) -> %% Opens a file and returns a reader (lazy list). gen_reader_file(ReadFun, Filename) -> - case file:open(Filename, [read, raw, binary]) of + case file:open(Filename, [read, raw, binary, read_ahead]) of {ok, File} -> mk_reader(ReadFun, File); Error -> exit({client_cannot_open, Error}) end. +-dialyzer({no_improper_lists, mk_reader/2}). + %% Creates and returns a reader (lazy list). mk_reader(ReadFun, Source) -> fun() -> @@ -1294,13 +1296,15 @@ mk_reader(ReadFun, Source) -> mk_reader_wrap([]) -> []; mk_reader_wrap([Hd | _] = WrapFiles) -> - case file:open(wrap_name(Hd), [read, raw, binary]) of + case file:open(wrap_name(Hd), [read, raw, binary, read_ahead]) of {ok, File} -> mk_reader_wrap(WrapFiles, File); Error -> exit({client_cannot_open, Error}) end. +-dialyzer({no_improper_lists, mk_reader_wrap/2}). + mk_reader_wrap([_Hd | Tail] = WrapFiles, File) -> fun() -> case read_term(fun file_read/2, File) of diff --git a/lib/runtime_tools/src/msacc.erl b/lib/runtime_tools/src/msacc.erl new file mode 100644 index 0000000000..612effa5aa --- /dev/null +++ b/lib/runtime_tools/src/msacc.erl @@ -0,0 +1,355 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2014-2015. 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% +%% + +%% +%% @doc Microstate accounting utility function +%% +%% This module provides a user interface for analysing +%% erlang:statistics(microstate_accounting) data. +%% + +-module(msacc). +-export([available/0, start/0, start/1, stop/0, reset/0, to_file/1, + from_file/1, stats/0, stats/2, print/0, print/1, print/2, + print/3]). + +-type msacc_data() :: [msacc_data_thread()]. + +-type msacc_data_thread() :: #{ '$type' => msacc_data, + type => msacc_type(), id => msacc_id(), + counters => msacc_data_counters() }. +-type msacc_data_counters() :: #{ msacc_state() => non_neg_integer()}. + +-type msacc_stats() :: [msacc_stats_thread()]. +-type msacc_stats_thread() :: #{ '$type' => msacc_stats, + type => msacc_type(), id => msacc_id(), + system => float(), + counters => msacc_stats_counters()}. +-type msacc_stats_counters() :: #{ msacc_state() => #{ thread => float(), + system => float()}}. + + +-type msacc_type() :: scheduler | aux | async. +-type msacc_id() :: non_neg_integer(). +-type msacc_state() :: alloc | aux | bif | busy_wait | check_io | + emulator | ets | gc | gc_fullsweep | nif | + other | port | send | sleep | timers. + +-type msacc_print_options() :: #{ system => boolean() }. + +-spec available() -> boolean(). +available() -> + try + [_|_] = erlang:statistics(microstate_accounting), + true + catch _:_ -> + false + end. + +-spec start() -> boolean(). +start() -> + erlang:system_flag(microstate_accounting, true). + +-spec stop() -> boolean(). +stop() -> + erlang:system_flag(microstate_accounting, false). + +-spec reset() -> boolean(). +reset() -> + erlang:system_flag(microstate_accounting, reset). + +-spec start(Time) -> true when + Time :: timeout(). +start(Tmo) -> + stop(), reset(), start(), + timer:sleep(Tmo), + stop(). + +-spec to_file(Filename) -> ok | {error, file:posix()} when + Filename :: file:name_all(). +to_file(Filename) -> + file:write_file(Filename, io_lib:format("~p.~n",[stats()])). + +-spec from_file(Filename) -> msacc_data() when + Filename :: file:name_all(). +from_file(Filename) -> + {ok, [Stats]} = file:consult(Filename), + Stats. + +-spec print() -> ok. +print() -> + print(stats()). + +-spec print(DataOrStats) -> ok when + DataOrStats :: msacc_data() | msacc_stats(). +print(Stats) -> + print(Stats, #{}). + +-spec print(DataOrStats, Options) -> ok when + DataOrStats :: msacc_data() | msacc_stats(), + Options :: msacc_print_options(). +print(Stats, Options) -> + print(group_leader(), Stats, Options). + +-spec print(FileOrDevice, DataOrStats, Options) -> ok when + FileOrDevice :: file:filename() | io:device(), + DataOrStats :: msacc_data() | msacc_stats(), + Options :: msacc_print_options(). +print(Filename, Stats, Options) when is_list(Filename) -> + case file:open(Filename,[write]) of + {ok, D} -> print(D, Stats, Options),file:close(D); + Error -> Error + end; +print(Device, Stats, Options) -> + DefaultOpts = #{ system => false }, + print_int(Device, Stats, maps:merge(DefaultOpts, Options)). +print_int(Device, [#{ '$type' := msacc_data, id := _Id }|_] = Stats, Options) -> + TypeStats = stats(type, Stats), + io:format(Device, "~s", [print_stats_overview(Stats, Options)]), + io:format(Device, "~s", [print_stats_header(Stats, Options)]), + io:format(Device, "~s", [print_stats_threads( + stats(realtime, Stats), Options)]), + io:format(Device, "~s", [print_stats_type( + stats(realtime, TypeStats), Options)]); +print_int(Device, [#{ '$type' := msacc_data }|_] = Stats, Options) -> + io:format(Device, "~s", [print_stats_header(Stats, Options)]), + io:format(Device, "~s", [print_stats_type( + stats(realtime, Stats), Options)]); +print_int(Device, [#{ '$type' := msacc_stats, id := _Id }|_] = Stats,Options) -> + io:format(Device, "~s", [print_stats_header(Stats, Options)]), + io:format(Device, "~s", [print_stats_threads(Stats, Options)]), + io:format(Device, "~s", [print_stats_type( + msacc:stats(type, Stats), Options)]); +print_int(Device, [#{ '$type' := msacc_stats }|_] = Stats, Options) -> + io:format(Device, "~s", [print_stats_header(Stats, Options)]), + io:format(Device, "~s", [print_stats_type(Stats, Options)]). + + +-spec stats() -> msacc_data(). +stats() -> + Fun = fun F(K,{PerfCount,StateCount}) -> + %% Need to handle ERTS_MSACC_STATE_COUNTERS + {F(K,PerfCount),StateCount}; + F(_K,PerfCount) -> + erlang:convert_time_unit(PerfCount, perf_counter, 1000000) + end, + UsStats = lists:map( + fun(#{ counters := Cnt } = M) -> + UsCnt = maps:map(Fun,Cnt), + M#{ '$type' => msacc_data, counters := UsCnt } + end, erlang:statistics(microstate_accounting)), + statssort(UsStats). + +-spec stats(Analysis, Stats) -> non_neg_integer() when + Analysis :: system_realtime | system_runtime, + Stats :: msacc_data(); + (Analysis, Stats) -> msacc_stats() when + Analysis :: realtime | runtime, + Stats :: msacc_data(); + (Analysis, StatsOrData) -> msacc_data() | msacc_stats() when + Analysis :: type, + StatsOrData :: msacc_data() | msacc_stats(). +stats(system_realtime, Stats) -> + lists:foldl(fun(#{ counters := Cnt }, Acc) -> + get_total(Cnt, Acc) + end, 0, Stats); +stats(system_runtime, Stats) -> + lists:foldl(fun(#{ counters := Cnt }, Acc) -> + get_total(maps:remove(sleep, Cnt), Acc) + end, 0, Stats); +stats(realtime, Stats) -> + RealTime = stats(system_realtime, Stats), + statssort([get_thread_perc(Thread, RealTime) || Thread <- Stats]); +stats(runtime, Stats) -> + RunTime = stats(system_runtime, Stats), + statssort([get_thread_perc(T#{ counters := maps:remove(sleep,Cnt)}, RunTime) + || T = #{ counters := Cnt } <- Stats]); +stats(type, Stats) -> + statssort(merge_threads(Stats, [])). + +print_stats_overview(Stats, _Options) -> + RunTime = stats(system_runtime, Stats), + RealTime = stats(system_realtime, Stats) div length(Stats), + SchedStats = [S || #{ type := scheduler } = S <- Stats], + AvgSchedRunTime = stats(system_runtime, SchedStats) div length(SchedStats), + NumSize = if + RealTime > RunTime -> length(integer_to_list(RealTime)); + true -> length(integer_to_list(RunTime)) + end, + [io_lib:format("Average thread real-time : ~*B us~n", + [NumSize, RealTime]), + io_lib:format("Accumulated system run-time : ~*B us~n", + [NumSize, RunTime]), + io_lib:format("Average scheduler run-time : ~*B us~n", + [NumSize, AvgSchedRunTime]), + io_lib:format("~n",[])]. + +print_stats_threads(Stats, Options) -> + [io_lib:format("~nStats per thread:~n", []), + [print_thread_info(Thread, Options) || Thread <- Stats]]. + +print_stats_type(Stats, Options) -> + [io_lib:format("~nStats per type:~n", []), + [print_thread_info(Thread, Options) || Thread <- Stats]]. + + +print_stats_header([#{ counters := Cnt }|_], #{ system := PrintSys }) -> + [io_lib:format("~14s", ["Thread"]), + map(fun(Counter, _) when PrintSys-> + io_lib:format("~9s ", [atom_to_list(Counter)]); + (Counter, _) -> + io_lib:format("~9s", [atom_to_list(Counter)]) + end, Cnt), + io_lib:format("~n",[])]. + +print_thread_info(#{ '$type' := msacc_stats, + counters := Cnt } = Thread, #{ system := PrintSys }) -> + [case maps:find(id, Thread) of + error -> + io_lib:format("~14s", [atom_to_list(maps:get(type, Thread))]); + {ok, Id} -> + io_lib:format("~10s(~2B)", [atom_to_list(maps:get(type,Thread)),Id]) + end, + map(fun(_Key, #{ thread := ThreadPerc, system := SystemPerc }) when PrintSys -> + io_lib:format("~6.2f%(~4.1f%)", [ThreadPerc, SystemPerc]); + (_Key, #{ thread := ThreadPerc }) -> + io_lib:format("~8.2f%", [ThreadPerc]) + end, Cnt), + io_lib:format("~n",[])]. + +get_total(Cnt, Base) -> + maps:fold(fun(_, {Val,_}, Time) -> + %% Have to handle ERTS_MSACC_STATE_COUNTERS + Time + Val; + (_, Val, Time) -> Time + Val + end, Base, Cnt). + +get_thread_perc(#{ '$type' := msacc_data, counters := Cnt } = Thread, + SystemTime) -> + ThreadTime = get_total(Cnt, 0), + Thread#{ '$type' := msacc_stats, + system => percentage(ThreadTime,SystemTime), + counters => get_thread_perc(Cnt, ThreadTime, SystemTime)}. +get_thread_perc(Cnt, ThreadTime, SystemTime) -> + maps:map(fun F(Key, {Val, C}) -> + M = F(Key, Val), + M#{ cnt => C }; + F(_Key, Val) -> + #{ thread => percentage(Val, ThreadTime), + system => percentage(Val, SystemTime) } + end, Cnt). + +%% This code is a little bit messy as it has to be able to deal with +%% both [msacc_data()] and [msacc_stats()]. +merge_threads([#{ '$type' := msacc_stats, + type := Type, + counters := Cnt } = M0|R], Acc) -> + case keyfind(type, Type, Acc) of + false -> + merge_threads(R, [maps:remove(id,M0#{ threads => 1 })|Acc]); + #{ '$type' := msacc_stats, counters := Cnt0, + threads := Threads, system := System } = M -> + NewMap = M#{ counters := add_counters(Cnt, Cnt0), + system := System + maps:get(system, M0), + threads := Threads + 1}, + NewAcc = keyreplace(type, Type, NewMap, Acc), + merge_threads(R, NewAcc) + end; +merge_threads([], [#{ '$type' := msacc_stats, + system := System, + threads := Threads, + counters := Cnt} = M0|R]) -> + Counters = maps:map(fun(_,#{ thread := Thr } = Map) -> + Map#{ thread := Thr / Threads } + end, Cnt), + M = maps:remove(threads, M0), + [M#{ system := System, counters := Counters} | merge_threads([],R)]; +merge_threads([], []) -> + []; +%% The clauses below deal with msacc_data() +merge_threads([#{ '$type' := msacc_data, + type := Type, + counters := Cnt } = M0|R], Acc) -> + case keyfind(type, Type, Acc) of + false -> + merge_threads(R, [maps:remove(id,M0)|Acc]); + #{ '$type' := msacc_data, counters := Cnt0 } = M -> + NewMap = M#{ counters := add_counters(Cnt, Cnt0) }, + NewAcc = keyreplace(type, Type, NewMap, Acc), + merge_threads(R, NewAcc) + end; +merge_threads([], Acc) -> + Acc. + +add_counters(M1, M2) -> + maps:map( + fun(Key, #{ thread := Thr1, system := Sys1, cnt := Cnt1}) -> + %% Have to handle ERTS_MSACC_STATE_COUNTERS + #{ thread := Thr2, system := Sys2, cnt := Cnt2} = maps:get(Key, M2), + #{ thread => Thr1 + Thr2, system => Sys1 + Sys2, + cnt => Cnt1 + Cnt2 }; + (Key, #{ thread := Thr1, system := Sys1}) -> + #{ thread := Thr2, system := Sys2} = maps:get(Key, M2), + #{ thread => Thr1 + Thr2, system => Sys1 + Sys2}; + (Key, {V1,C1}) -> + %% Have to handle ERTS_MSACC_STATE_COUNTERS + {V2,C2} = maps:get(Key, M2),{V1+V2,C1+C2}; + (Key, V1) -> maps:get(Key, M2) + V1 + end, M1). + +percentage(Divident, Divisor) -> + if Divisor == 0 andalso Divident /= 0 -> + 100.0; + Divisor == 0 -> + 0.0; + true -> + Divident / Divisor * 100 + end. + +keyfind(Key, Value, [H|T]) -> + case maps:find(Key, H) of + {ok, Value} -> + H; + _ -> + keyfind(Key, Value, T) + end; +keyfind(_, _, []) -> + false. + +keyreplace(Key, Value, NewMap, [H|T]) -> + case maps:find(Key, H) of + {ok, Value} -> + [NewMap|T]; + _ -> + [H|keyreplace(Key, Value, NewMap, T)] + end; +keyreplace(_, _, _, []) -> + []. + +statssort(Stats) -> + lists:sort(fun(#{ type := Type1, id := Id1}, + #{ type := Type2, id := Id2}) -> + {Type1, Id1} < {Type2, Id2}; + (#{ type := Type1}, #{ type := Type2}) -> + Type1 < Type2 + end, Stats). + +map(Fun,Map) -> + [ Fun(K,V) || {K,V} <- maps:to_list(Map) ]. diff --git a/lib/runtime_tools/src/runtime_tools.app.src b/lib/runtime_tools/src/runtime_tools.app.src index ad10655aa0..aeda103e72 100644 --- a/lib/runtime_tools/src/runtime_tools.app.src +++ b/lib/runtime_tools/src/runtime_tools.app.src @@ -22,7 +22,8 @@ {vsn, "%VSN%"}, {modules, [appmon_info, dbg,observer_backend,percept_profile, runtime_tools,runtime_tools_sup,erts_alloc_config, - ttb_autostart,dyntrace,system_information]}, + ttb_autostart,dyntrace,system_information, + msacc]}, {registered, [runtime_tools_sup]}, {applications, [kernel, stdlib]}, {env, []}, diff --git a/lib/runtime_tools/test/Makefile b/lib/runtime_tools/test/Makefile index dcb9082231..432a361468 100644 --- a/lib/runtime_tools/test/Makefile +++ b/lib/runtime_tools/test/Makefile @@ -7,7 +7,8 @@ MODULES = \ runtime_tools_SUITE \ system_information_SUITE \ dbg_SUITE \ - erts_alloc_config_SUITE + erts_alloc_config_SUITE \ + msacc_SUITE ERL_FILES= $(MODULES:%=%.erl) @@ -26,7 +27,7 @@ RELSYSDIR = $(RELEASE_PATH)/runtime_tools_test # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +ERL_COMPILE_FLAGS += EBIN = . diff --git a/lib/runtime_tools/test/dbg_SUITE.erl b/lib/runtime_tools/test/dbg_SUITE.erl index 11dd753eed..fd9b8f23bd 100644 --- a/lib/runtime_tools/test/dbg_SUITE.erl +++ b/lib/runtime_tools/test/dbg_SUITE.erl @@ -31,7 +31,7 @@ -export([tracee1/1, tracee2/1]). -export([dummy/0, exported/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(default_timeout, ?t:minutes(1)). init_per_testcase(_Case, Config) -> diff --git a/lib/runtime_tools/test/dyntrace_SUITE.erl b/lib/runtime_tools/test/dyntrace_SUITE.erl index 03242784dd..6d39bc54f4 100644 --- a/lib/runtime_tools/test/dyntrace_SUITE.erl +++ b/lib/runtime_tools/test/dyntrace_SUITE.erl @@ -18,7 +18,7 @@ %% %CopyrightEnd% %% -module(dyntrace_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). diff --git a/lib/runtime_tools/test/erts_alloc_config_SUITE.erl b/lib/runtime_tools/test/erts_alloc_config_SUITE.erl index 9c0a643e91..a5c4801af9 100644 --- a/lib/runtime_tools/test/erts_alloc_config_SUITE.erl +++ b/lib/runtime_tools/test/erts_alloc_config_SUITE.erl @@ -22,7 +22,7 @@ %-define(line_trace, 1). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %-compile(export_all). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/lib/runtime_tools/test/msacc_SUITE.erl b/lib/runtime_tools/test/msacc_SUITE.erl new file mode 100644 index 0000000000..145a6d07fb --- /dev/null +++ b/lib/runtime_tools/test/msacc_SUITE.erl @@ -0,0 +1,132 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2014-2015. 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(msacc_SUITE). + +-include_lib("common_test/include/ct.hrl"). + +%% Test server callbacks +-export([suite/0, all/0]). + +%% Test cases +-export([ + %% API-test + api_file/1, + api_start_stop/1, + api_timer/1, + api_print/1 + ]). + +%%-------------------------------------------------------------------- +%% COMMON TEST CALLBACK FUNCTIONS +%%-------------------------------------------------------------------- +all() -> + [ + api_start_stop, + api_file, + api_timer, + api_print + ]. + +suite() -> [ + {timetrap,{minutes,1}}, + {ct_hooks,[ts_install_cth]} + ]. + +%%-------------------------------------------------------------------- +%% TEST CASES +%%-------------------------------------------------------------------- + +api_timer(_Config) -> + + %% Run msacc for about 100ms + msacc:start(100), + + %% Verify that scheduler 1 executed+slept for about 100ms + [Sched1] = [S || S = #{ type := scheduler, id := 1 } <- msacc:stats()], + + #{ counters := Cnt } = Sched1, + + %% Time should be in us + Time = maps:fold(fun(_,V,Acc) -> V + Acc end, 0, Cnt), + + if Time < 120000 andalso Time > 80000 -> ok; + true -> ct:fail({inaccurate_time, Time, msacc:stats()}) + end. + +%% We just do a basic check that none of the apis crash +api_start_stop(_Config) -> + msacc:start(), + timer:sleep(100), + msacc:stop(), + Runtime = msacc:stats(system_runtime, msacc:stats()), + Realtime = msacc:stats(system_realtime, msacc:stats()), + true = Runtime < Realtime, + + RuntimeCnt = msacc:stats(runtime, msacc:stats()), + RealtimeCnt = msacc:stats(realtime, msacc:stats()), + TypeCnt = msacc:stats(type, msacc:stats()), + + %% These should be very similar + RuntimeTypeCnt = msacc:stats(type, RuntimeCnt), + TypeRuntimeCnt = msacc:stats(runtime, TypeCnt), + lists:map(fun({#{ system := T1 },#{ system := T2}}) -> + if T1-0.5 < T2 orelse T1+0.5 > T2 -> ok; + true -> ct:fail({inaccurate_stats, RuntimeTypeCnt, + TypeRuntimeCnt}) + end + end, lists:zip(RuntimeTypeCnt, TypeRuntimeCnt)), + + %% These should be very similar + RealtimeTypeCnt = msacc:stats(type, RealtimeCnt), + TypeRealtimeCnt = msacc:stats(realtime, TypeCnt), + lists:map(fun({#{ system := T1 },#{ system := T2}}) -> + if T1-0.5 < T2 orelse T1+0.5 > T2 -> ok; + true -> ct:fail({inaccurate_stats, RealtimeTypeCnt, + TypeRealtimeCnt}) + end + end,lists:zip(RealtimeTypeCnt, TypeRealtimeCnt)), + + msacc:reset(). + +api_file(Config) -> + PrivDir = proplists:get_value(priv_dir, Config), + File = filename:join(PrivDir, "msacc.stats"), + Stats = msacc:stats(), + ok = msacc:to_file(File), + Stats = msacc:from_file(File), + + PrintFile = filename:join(PrivDir, "msacc.txt"), + msacc:print(PrintFile, Stats, #{}). + +%% We just check that it is possible to print in a couple of different ways +api_print(_Config) -> + msacc:start(100), + io:format("msacc:print(msacc:stats()).~n"), + msacc:print(msacc:stats()), + io:format("msacc:print(msacc:stats(),#{ system => true }).~n"), + msacc:print(msacc:stats(), #{ system => true }), + io:format("msacc:print(msacc:stats(runtime,msacc:stats())).~n"), + msacc:print(msacc:stats(runtime, msacc:stats())), + io:format("msacc:print(msacc:stats(type,msacc:stats())).~n"), + msacc:print(msacc:stats(type, msacc:stats())), + io:format("msacc:print(msacc:stats(realtime,msacc:stats())).~n"), + msacc:print(msacc:stats(realtime, msacc:stats())), + io:format("msacc:stats(type,msacc:stats(runtime,msacc:stats())).~n"), + msacc:print(msacc:stats(type, msacc:stats(runtime, msacc:stats()))). diff --git a/lib/runtime_tools/test/runtime_tools_SUITE.erl b/lib/runtime_tools/test/runtime_tools_SUITE.erl index 7599026e7e..2a79f0a8f9 100644 --- a/lib/runtime_tools/test/runtime_tools_SUITE.erl +++ b/lib/runtime_tools/test/runtime_tools_SUITE.erl @@ -18,7 +18,7 @@ %% %CopyrightEnd% %% -module(runtime_tools_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Test server specific exports -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/lib/sasl/doc/src/overload.xml b/lib/sasl/doc/src/overload.xml index 5c3d00afeb..2f19cd9088 100644 --- a/lib/sasl/doc/src/overload.xml +++ b/lib/sasl/doc/src/overload.xml @@ -35,6 +35,12 @@ <module>overload</module> <modulesummary>An Overload Regulation Process</modulesummary> <description> + <warning> + <p> + All functions in this module are deprecated and will be + removed in a future release. + </p> + </warning> <p><c>overload</c> is a process that indirectly regulates the CPU usage in the system. The idea is that a main application calls function diff --git a/lib/sasl/doc/src/sasl_app.xml b/lib/sasl/doc/src/sasl_app.xml index 8d79251c7e..bcd446a868 100644 --- a/lib/sasl/doc/src/sasl_app.xml +++ b/lib/sasl/doc/src/sasl_app.xml @@ -34,7 +34,7 @@ <p>The <c>SASL</c> application provides the following services:</p> <list type="bulleted"> <item><c>alarm_handler</c></item> - <item><c>overload</c></item> + <item><c>overload</c> (deprecated)</item> <item><c>rb</c></item> <item><c>release_handler</c></item> <item><c>systools</c></item> @@ -145,11 +145,15 @@ <p>Specifies the maximum intensity for <seealso marker="overload"><c>overload</c></seealso>. Default is <c>0.8</c>.</p> + <p>Note that the <c>overload</c> module is deprected and + will be removed in a future release.</p> </item> <tag><c><![CDATA[overload_weight = float() > 0 ]]></c></tag> <item> <p>Specifies the <seealso marker="overload"><c>overload</c></seealso> weight. Default is <c>0.1</c>.</p> + <p>Note that the <c>overload</c> module is deprected and + will be removed in a future release.</p> </item> <tag><c><![CDATA[start_prg = string() ]]></c></tag> <item> diff --git a/lib/sasl/src/overload.erl b/lib/sasl/src/overload.erl index 61b925d219..bc8ab7d5e4 100644 --- a/lib/sasl/src/overload.erl +++ b/lib/sasl/src/overload.erl @@ -19,6 +19,8 @@ %% -module(overload). +-deprecated(module). + -export([start_link/0, request/0, set_config_data/2, get_overload_info/0]). diff --git a/lib/sasl/src/release_handler_1.erl b/lib/sasl/src/release_handler_1.erl index 536ac924d4..a6325270a5 100644 --- a/lib/sasl/src/release_handler_1.erl +++ b/lib/sasl/src/release_handler_1.erl @@ -587,12 +587,12 @@ get_supervised_procs() -> get_application_names()). get_supervised_procs(_, Root, Procs, {ok, SupMod}) -> - get_procs(maybe_supervisor_which_children(get_proc_state(Root), SupMod, Root), Root) ++ + get_procs(maybe_supervisor_which_children(Root, SupMod, Root), Root) ++ [{undefined, undefined, Root, [SupMod]} | Procs]; get_supervised_procs(Application, Root, Procs, {error, _}) -> error_logger:error_msg("release_handler: cannot find top supervisor for " "application ~w~n", [Application]), - get_procs(maybe_supervisor_which_children(get_proc_state(Root), Application, Root), Root) ++ Procs. + get_procs(maybe_supervisor_which_children(Root, Application, Root), Root) ++ Procs. get_application_names() -> lists:map(fun({Application, _Name, _Vsn}) -> @@ -613,33 +613,54 @@ get_procs([{Name, Pid, worker, Mods} | T], Sup) when is_pid(Pid), is_list(Mods) [{Sup, Name, Pid, Mods} | get_procs(T, Sup)]; get_procs([{Name, Pid, supervisor, Mods} | T], Sup) when is_pid(Pid) -> [{Sup, Name, Pid, Mods} | get_procs(T, Sup)] ++ - get_procs(maybe_supervisor_which_children(get_proc_state(Pid), Name, Pid), Pid); + get_procs(maybe_supervisor_which_children(Pid, Name, Pid), Pid); get_procs([_H | T], Sup) -> get_procs(T, Sup); get_procs(_, _Sup) -> []. +maybe_supervisor_which_children(Proc, Name, Pid) -> + case get_proc_state(Proc) of + noproc -> + %% process exited before we could interrogate it. + %% not necessarily a bug, but reporting a warning as a curiosity. + error_logger:warning_msg("release_handler: a process (~p) exited" + " during supervision tree interrogation." + " Continuing ...~n", [Proc]), + []; + + suspended -> + error_logger:error_msg("release_handler: a which_children call" + " to ~p (~w) was avoided. This supervisor" + " is suspended and should likely be upgraded" + " differently. Exiting ...~n", [Name, Pid]), + error(suspended_supervisor); + + running -> + case catch supervisor:which_children(Pid) of + Res when is_list(Res) -> + Res; + Other -> + error_logger:error_msg("release_handler: ~p~nerror during" + " a which_children call to ~p (~w)." + " [State: running] Exiting ... ~n", + [Other, Name, Pid]), + error(which_children_failed) + end + end. + get_proc_state(Proc) -> - {status, _, {module, _}, [_, State, _, _, _]} = sys:get_status(Proc), - State. - -maybe_supervisor_which_children(suspended, Name, Pid) -> - error_logger:error_msg("release_handler: a which_children call" - " to ~p (~w) was avoided. This supervisor" - " is suspended and should likely be upgraded" - " differently. Exiting ...~n", [Name, Pid]), - error(suspended_supervisor); - -maybe_supervisor_which_children(State, Name, Pid) -> - case catch supervisor:which_children(Pid) of - Res when is_list(Res) -> - Res; - Other -> - error_logger:error_msg("release_handler: ~p~nerror during" - " a which_children call to ~p (~w)." - " [State: ~p] Exiting ... ~n", - [Other, Name, Pid, State]), - error(which_children_failed) + %% sys:send_system_msg can exit with {noproc, {m,f,a}}. + %% This happens if a supervisor exits after which_children has provided + %% its pid for interrogation. + %% ie. Proc may no longer be running at this point. + try sys:get_status(Proc) of + %% as per sys:get_status/1, SysState can only be running | suspended. + {status, _, {module, _}, [_, State, _, _, _]} when State == running ; + State == suspended -> + State + catch exit:{noproc, {sys, get_status, [Proc]}} -> + noproc end. maybe_get_dynamic_mods(Name, Pid) -> @@ -655,48 +676,19 @@ maybe_get_dynamic_mods(Name, Pid) -> error(get_modules_failed) end. -%% XXXX -%% Note: The following is a terrible hack done in order to resolve the -%% problem stated in ticket OTP-3452. - -%% XXXX NOTE WELL: This record is from supervisor.erl. Also the record -%% name is really `state'. --record(supervisor_state, {name, - strategy, - children = [], - dynamics = [], - intensity, - period, - restarts = [], - module, - args}). - %% Return the name of the call-back module that implements the %% (top) supervisor SupPid. %% Returns: {ok, Module} | {error,undefined} %% get_supervisor_module(SupPid) -> - case catch get_supervisor_module1(SupPid) of - {ok, Module} when is_atom(Module) -> + case catch supervisor:get_callback_module(SupPid) of + Module when is_atom(Module) -> {ok, Module}; _Other -> io:format("~w: reason: ~w~n", [SupPid, _Other]), {error, undefined} end. -get_supervisor_module1(SupPid) -> - {status, _Pid, {module, _Mod}, - [_PDict, _SysState, _Parent, _Dbg, Misc]} = sys:get_status(SupPid), - %% supervisor Misc field changed at R13B04, handle old and new variants here - State = case Misc of - [_Name, State1, _Type, _Time] -> - State1; - [_Header, _Data, {data, [{"State", State2}]}] -> - State2 - end, - %% Cannot use #supervisor_state{module = Module} = State. - {ok, element(#supervisor_state.module, State)}. - %%----------------------------------------------------------------- %% Func: do_soft_purge/3 %% Args: Mod = atom() diff --git a/lib/sasl/src/sasl.app.src b/lib/sasl/src/sasl.app.src index 705bb73fc5..507e2dc229 100644 --- a/lib/sasl/src/sasl.app.src +++ b/lib/sasl/src/sasl.app.src @@ -46,6 +46,6 @@ {env, [{sasl_error_logger, tty}, {errlog_type, all}]}, {mod, {sasl, []}}, - {runtime_dependencies, ["tools-2.6.14","stdlib-2.6","kernel-4.1", + {runtime_dependencies, ["tools-2.6.14","stdlib-2.8","kernel-4.1", "erts-6.0"]}]}. diff --git a/lib/sasl/src/systools_make.erl b/lib/sasl/src/systools_make.erl index 8132034172..d207dc15bb 100644 --- a/lib/sasl/src/systools_make.erl +++ b/lib/sasl/src/systools_make.erl @@ -1469,7 +1469,9 @@ mandatory_modules() -> preloaded() -> %% Sorted - [erl_prim_loader,erlang,erts_internal,init,otp_ring0,prim_eval,prim_file, + [erl_prim_loader,erlang, + erts_code_purger, + erts_internal,init,otp_ring0,prim_eval,prim_file, prim_inet,prim_zip,zlib]. %%______________________________________________________________________ diff --git a/lib/sasl/test/Makefile b/lib/sasl/test/Makefile index 86976def6a..6f67498714 100644 --- a/lib/sasl/test/Makefile +++ b/lib/sasl/test/Makefile @@ -55,8 +55,7 @@ RELSYSDIR = $(RELEASE_PATH)/sasl_test # FLAGS # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include \ - -I$(ERL_TOP)/lib/sasl/src +ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/sasl/src EBIN = . diff --git a/lib/sasl/test/release_handler_SUITE.erl b/lib/sasl/test/release_handler_SUITE.erl index d57de2593a..ee620dcdb4 100644 --- a/lib/sasl/test/release_handler_SUITE.erl +++ b/lib/sasl/test/release_handler_SUITE.erl @@ -1363,7 +1363,7 @@ upgrade_supervisor(Conf) when is_list(Conf) -> %% Check that the restart strategy and child spec is updated {status, _, {module, _}, [_, _, _, _, [_,_,{data,[{"State",State}]}]]} = rpc:call(Node,sys,get_status,[a_sup]), - {state,_,RestartStrategy,[Child],_,_,_,_,_,_} = State, + {state,_,RestartStrategy,[Child],_,_,_,_,_,_,_} = State, one_for_all = RestartStrategy, % changed from one_for_one {child,_,_,_,_,brutal_kill,_,_} = Child, % changed from timeout 2000 diff --git a/lib/sasl/test/sasl_report_SUITE.erl b/lib/sasl/test/sasl_report_SUITE.erl index 940234f152..7469ec4d46 100644 --- a/lib/sasl/test/sasl_report_SUITE.erl +++ b/lib/sasl/test/sasl_report_SUITE.erl @@ -24,7 +24,7 @@ -export([crash_me/0,start_link/0,init/1,handle_cast/2,terminate/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/sasl/test/systools_SUITE.erl b/lib/sasl/test/systools_SUITE.erl index cf0ed5fcfc..825a7f6e86 100644 --- a/lib/sasl/test/systools_SUITE.erl +++ b/lib/sasl/test/systools_SUITE.erl @@ -1640,25 +1640,21 @@ app_start_type_relup(Dir2,Name2,Config) -> %% ?t:format("Dn: ~p",[DownInstructions]), [{load_object_code, {mnesia, _, _}}, {load_object_code, {runtime_tools, _, _}}, - {load_object_code, {webtool, _, _}}, {load_object_code, {snmp, _, _}}, {load_object_code, {xmerl, _, _}}, point_of_no_return | UpInstructionsT] = UpInstructions, true = lists:member({apply,{application,start,[mnesia,permanent]}}, UpInstructionsT), true = lists:member({apply,{application,start,[runtime_tools,transient]}}, UpInstructionsT), - true = lists:member({apply,{application,start,[webtool,temporary]}}, UpInstructionsT), true = lists:member({apply,{application,load,[snmp]}}, UpInstructionsT), false = lists:any(fun({apply,{application,_,[xmerl|_]}}) -> true; (_) -> false end, UpInstructionsT), [point_of_no_return | DownInstructionsT] = DownInstructions, true = lists:member({apply,{application,stop,[mnesia]}}, DownInstructionsT), true = lists:member({apply,{application,stop,[runtime_tools]}}, DownInstructionsT), - true = lists:member({apply,{application,stop,[webtool]}}, DownInstructionsT), true = lists:member({apply,{application,stop,[snmp]}}, DownInstructionsT), true = lists:member({apply,{application,stop,[xmerl]}}, DownInstructionsT), true = lists:member({apply,{application,unload,[mnesia]}}, DownInstructionsT), true = lists:member({apply,{application,unload,[runtime_tools]}}, DownInstructionsT), - true = lists:member({apply,{application,unload,[webtool]}}, DownInstructionsT), true = lists:member({apply,{application,unload,[snmp]}}, DownInstructionsT), true = lists:member({apply,{application,unload,[xmerl]}}, DownInstructionsT), ok. @@ -2207,7 +2203,6 @@ create_script(latest_app_start_type1,Config) -> create_script(latest_app_start_type2,Config) -> OtherApps = [{mnesia,current,permanent}, {runtime_tools,current,transient}, - {webtool,current,temporary}, {snmp,current,load}, {xmerl,current,none}], Apps = core_apps(current) ++ OtherApps, diff --git a/lib/sasl/test/systools_rc_SUITE.erl b/lib/sasl/test/systools_rc_SUITE.erl index 3754ed99f2..2ecb6f107a 100644 --- a/lib/sasl/test/systools_rc_SUITE.erl +++ b/lib/sasl/test/systools_rc_SUITE.erl @@ -26,10 +26,6 @@ translate_emulator_restarts/1, translate_add_delete_module/1]). -%%----------------------------------------------------------------- -%% erl -compile systools_rc_SUITE @i ../src/ @i ../../test_server/include/ -%% c(systools_rc_SUITE, [{i, "../src"}, {i, "../../test_server/include"}]). -%%----------------------------------------------------------------- all() -> [syntax_check, translate, translate_app, translate_emulator_restarts, translate_add_delete_module]. diff --git a/lib/snmp/src/agent/snmp_view_based_acm_mib.erl b/lib/snmp/src/agent/snmp_view_based_acm_mib.erl index 586b7c7171..9e6aa74d45 100644 --- a/lib/snmp/src/agent/snmp_view_based_acm_mib.erl +++ b/lib/snmp/src/agent/snmp_view_based_acm_mib.erl @@ -34,6 +34,8 @@ %% Internal exports -export([check_vacm/1]). +%% +-export([emask2imask/1]). -include("snmp_types.hrl"). diff --git a/lib/snmp/src/agent/snmpa_acm.erl b/lib/snmp/src/agent/snmpa_acm.erl index 7327575846..0264c6a992 100644 --- a/lib/snmp/src/agent/snmpa_acm.erl +++ b/lib/snmp/src/agent/snmpa_acm.erl @@ -280,7 +280,7 @@ validate_mib_view(Oid, MibView) -> end. get_largest_family([{SubTree, Mask, Type} | T], Oid, Res) -> - case check_mask(Oid, SubTree, Mask) of + case check_mask(Oid, SubTree, snmp_view_based_acm_mib:emask2imask(Mask)) of true -> get_largest_family(T, Oid, add_res(length(SubTree), SubTree, Type, Res)); false -> get_largest_family(T, Oid, Res) @@ -345,7 +345,7 @@ validate_all_mib_view([], _MibView) -> %% intelligent. %%----------------------------------------------------------------- is_definitely_not_in_mib_view(Oid, [{SubTree, Mask,?view_included}|T]) -> - case check_maybe_mask(Oid, SubTree, Mask) of + case check_maybe_mask(Oid, SubTree, snmp_view_based_acm_mib:emask2imask(Mask)) of true -> false; false -> is_definitely_not_in_mib_view(Oid, T) end; diff --git a/lib/snmp/src/app/snmp.appup.src b/lib/snmp/src/app/snmp.appup.src index 77418f920f..ca61782639 100644 --- a/lib/snmp/src/app/snmp.appup.src +++ b/lib/snmp/src/app/snmp.appup.src @@ -1,71 +1,24 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2015. 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% -%% - - +%% -*- erlang -*- {"%VSN%", %% ----- U p g r a d e ------------------------------------------------------- - %% Instruction examples: %% {restart_application, snmp} %% {load_module, snmp_pdus, soft_purge, soft_purge, []} %% {update, snmpa_local_db, soft, soft_purge, soft_purge, []} %% {add_module, snmpm_net_if_mt} [ - {"5.2", [{load_module, snmp_conf, soft_purge, soft_purge, []}]}, - {"5.1.2", [ % Only runtime dependencies change - ]}, - {"5.1.1", [{restart_application, snmp}]}, - {"5.1", [ % Only compiler changes - ]}, - {"5.0", [{restart_application, snmp}]}, - {"4.25.1", [{restart_application, snmp}]}, - {"4.25.0.1", [{restart_application, snmp}]}, - {"4.25.0.0.1", [{restart_application, snmp}]}, - {"4.25", [{restart_application, snmp}]}, - {"4.24.2", [{restart_application, snmp}]}, - {"4.24.1", [{restart_application, snmp}]}, - {"4.24", [{restart_application, snmp}]} - ], - + {<<"5\\..*">>, [{restart_application, snmp}]}, + {<<"4\\..*">>, [{restart_application, snmp}]} + ], + %% ------D o w n g r a d e --------------------------------------------------- - %% Instruction examples: %% {remove, {snmpm_net_if_mt, soft_purge, soft_purge}} - + [ - {"5.2", [{load_module, snmp_conf, soft_purge, soft_purge, []}]}, - {"5.1.2", [ % Only runtime dependencies change - ]}, - {"5.1.1", [{restart_application, snmp}]}, - {"5.1", [ % Only compiler changes - ]}, - {"5.0", [{restart_application, snmp}]}, - {"4.25.1", [{restart_application, snmp}]}, - {"4.25.0.1", [{restart_application, snmp}]}, - {"4.25.0.0.1", [{restart_application, snmp}]}, - {"4.25", [{restart_application, snmp}]}, - {"4.24.2", [{restart_application, snmp}]}, - {"4.24.1", [{restart_application, snmp}]}, - {"4.24", [{restart_application, snmp}]} - ] - -}. + {<<"5\\..*">>, [{restart_application, snmp}]}, + {<<"4\\..*">>, [{restart_application, snmp}]} + ] +}. diff --git a/lib/snmp/test/Makefile b/lib/snmp/test/Makefile index 3261982a32..8e895bc5b1 100644 --- a/lib/snmp/test/Makefile +++ b/lib/snmp/test/Makefile @@ -150,7 +150,6 @@ ERL_COMPILE_FLAGS += -I../../snmp/src/app \ -I../../snmp/src/misc \ -I../../snmp/src/agent \ -I../../snmp/src/manager \ - -I$(ERL_TOP)/lib/test_server/include \ -I../../snmp/include \ -Dsnmp_test_data=snmp_test_data \ -Dversion=\"$(VSN)$(PRE_VSN)\" \ diff --git a/lib/snmp/test/exp/snmp_agent_ms_test.erl b/lib/snmp/test/exp/snmp_agent_ms_test.erl index 3415fcc8e6..3010de0619 100644 --- a/lib/snmp/test/exp/snmp_agent_ms_test.erl +++ b/lib/snmp/test/exp/snmp_agent_ms_test.erl @@ -29,7 +29,7 @@ -define(application, snmp). -include_lib("kernel/include/file.hrl"). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("snmp_test_lib.hrl"). -define(SNMP_USE_V3, true). -include_lib("snmp/include/snmp_types.hrl"). diff --git a/lib/snmp/test/exp/snmp_agent_mt_test.erl b/lib/snmp/test/exp/snmp_agent_mt_test.erl index 89815e1044..71ae58baca 100644 --- a/lib/snmp/test/exp/snmp_agent_mt_test.erl +++ b/lib/snmp/test/exp/snmp_agent_mt_test.erl @@ -29,7 +29,7 @@ -define(application, snmp). -include_lib("kernel/include/file.hrl"). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("snmp_test_lib.hrl"). -define(SNMP_USE_V3, true). -include_lib("snmp/include/snmp_types.hrl"). diff --git a/lib/snmp/test/exp/snmp_agent_v1_test.erl b/lib/snmp/test/exp/snmp_agent_v1_test.erl index ec243747df..55045d536e 100644 --- a/lib/snmp/test/exp/snmp_agent_v1_test.erl +++ b/lib/snmp/test/exp/snmp_agent_v1_test.erl @@ -29,7 +29,7 @@ -define(application, snmp). -include_lib("kernel/include/file.hrl"). --include("test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("snmp_test_lib.hrl"). -define(SNMP_USE_V3, true). -include_lib("snmp/include/snmp_types.hrl"). diff --git a/lib/snmp/test/exp/snmp_agent_v2_test.erl b/lib/snmp/test/exp/snmp_agent_v2_test.erl index ce95d0b5cd..6238a6c4bd 100644 --- a/lib/snmp/test/exp/snmp_agent_v2_test.erl +++ b/lib/snmp/test/exp/snmp_agent_v2_test.erl @@ -29,7 +29,7 @@ -define(application, snmp). -include_lib("kernel/include/file.hrl"). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("snmp_test_lib.hrl"). -define(SNMP_USE_V3, true). -include_lib("snmp/include/snmp_types.hrl"). diff --git a/lib/snmp/test/exp/snmp_agent_v3_test.erl b/lib/snmp/test/exp/snmp_agent_v3_test.erl index 1ba06209b2..af7cee9b96 100644 --- a/lib/snmp/test/exp/snmp_agent_v3_test.erl +++ b/lib/snmp/test/exp/snmp_agent_v3_test.erl @@ -29,7 +29,7 @@ -define(application, snmp). -include_lib("kernel/include/file.hrl"). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("snmp_test_lib.hrl"). -define(SNMP_USE_V3, true). -include_lib("snmp/include/snmp_types.hrl"). diff --git a/lib/snmp/test/snmp_agent_mibs_test.erl b/lib/snmp/test/snmp_agent_mibs_test.erl index a03c2b8534..2cbba14c74 100644 --- a/lib/snmp/test/snmp_agent_mibs_test.erl +++ b/lib/snmp/test/snmp_agent_mibs_test.erl @@ -31,7 +31,7 @@ %% Include files %%---------------------------------------------------------------------- --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("snmp_test_lib.hrl"). -include_lib("snmp/include/snmp_types.hrl"). -include_lib("snmp/include/SNMP-COMMUNITY-MIB.hrl"). diff --git a/lib/snmp/test/snmp_agent_nfilter_test.erl b/lib/snmp/test/snmp_agent_nfilter_test.erl index 16a9903198..8aeef81333 100644 --- a/lib/snmp/test/snmp_agent_nfilter_test.erl +++ b/lib/snmp/test/snmp_agent_nfilter_test.erl @@ -26,7 +26,7 @@ %%---------------------------------------------------------------------- %% Include files %%---------------------------------------------------------------------- --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("snmp_test_lib.hrl"). diff --git a/lib/snmp/test/snmp_agent_test.erl b/lib/snmp/test/snmp_agent_test.erl index 412d62c6a1..93968ede2e 100644 --- a/lib/snmp/test/snmp_agent_test.erl +++ b/lib/snmp/test/snmp_agent_test.erl @@ -421,7 +421,7 @@ -define(application, snmp). -include_lib("kernel/include/file.hrl"). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("snmp_test_lib.hrl"). -define(SNMP_USE_V3, true). -include_lib("snmp/include/snmp_types.hrl"). diff --git a/lib/snmp/test/snmp_agent_test_lib.erl b/lib/snmp/test/snmp_agent_test_lib.erl index 8ea7b2e081..6f20254fcb 100644 --- a/lib/snmp/test/snmp_agent_test_lib.erl +++ b/lib/snmp/test/snmp_agent_test_lib.erl @@ -69,7 +69,7 @@ -export([wait/5, run/4]). -include_lib("kernel/include/file.hrl"). --include("test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("snmp_test_lib.hrl"). -define(SNMP_USE_V3, true). -include_lib("snmp/include/snmp_types.hrl"). diff --git a/lib/snmp/test/snmp_app_test.erl b/lib/snmp/test/snmp_app_test.erl index 3b5b196ad6..6892d4aa93 100644 --- a/lib/snmp/test/snmp_app_test.erl +++ b/lib/snmp/test/snmp_app_test.erl @@ -45,7 +45,7 @@ -include_lib("kernel/include/file.hrl"). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("snmp_test_lib.hrl"). diff --git a/lib/snmp/test/snmp_compiler_test.erl b/lib/snmp/test/snmp_compiler_test.erl index c83c4e0fed..b08181191f 100644 --- a/lib/snmp/test/snmp_compiler_test.erl +++ b/lib/snmp/test/snmp_compiler_test.erl @@ -29,7 +29,7 @@ %%---------------------------------------------------------------------- %% Include files %%---------------------------------------------------------------------- --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("snmp_test_lib.hrl"). -include_lib("snmp/include/snmp_types.hrl"). diff --git a/lib/snmp/test/snmp_conf_test.erl b/lib/snmp/test/snmp_conf_test.erl index 1d514cd1d2..73b471b107 100644 --- a/lib/snmp/test/snmp_conf_test.erl +++ b/lib/snmp/test/snmp_conf_test.erl @@ -27,7 +27,7 @@ %%---------------------------------------------------------------------- %% Include files %%---------------------------------------------------------------------- --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("snmp_test_lib.hrl"). -include_lib("snmp/include/STANDARD-MIB.hrl"). diff --git a/lib/snmp/test/snmp_log_test.erl b/lib/snmp/test/snmp_log_test.erl index b204522ee0..ae2581fb69 100644 --- a/lib/snmp/test/snmp_log_test.erl +++ b/lib/snmp/test/snmp_log_test.erl @@ -30,7 +30,7 @@ %%---------------------------------------------------------------------- %% Include files %%---------------------------------------------------------------------- --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("snmp_test_lib.hrl"). -define(SNMP_USE_V3, true). -include_lib("snmp/include/snmp_types.hrl"). diff --git a/lib/snmp/test/snmp_manager_config_test.erl b/lib/snmp/test/snmp_manager_config_test.erl index 47e150e8e8..8428b61e8a 100644 --- a/lib/snmp/test/snmp_manager_config_test.erl +++ b/lib/snmp/test/snmp_manager_config_test.erl @@ -32,7 +32,7 @@ %%---------------------------------------------------------------------- %% Include files %%---------------------------------------------------------------------- --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("snmp_test_lib.hrl"). -include_lib("snmp/src/manager/snmpm_usm.hrl"). diff --git a/lib/snmp/test/snmp_manager_test.erl b/lib/snmp/test/snmp_manager_test.erl index 3d05e5791f..a343dfdca7 100644 --- a/lib/snmp/test/snmp_manager_test.erl +++ b/lib/snmp/test/snmp_manager_test.erl @@ -32,7 +32,7 @@ %% Include files %%---------------------------------------------------------------------- --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("snmp_test_lib.hrl"). -include("snmp_test_data/Test2.hrl"). diff --git a/lib/snmp/test/snmp_manager_user.erl b/lib/snmp/test/snmp_manager_user.erl index 256ea6a834..55b1e23b2e 100644 --- a/lib/snmp/test/snmp_manager_user.erl +++ b/lib/snmp/test/snmp_manager_user.erl @@ -31,7 +31,7 @@ %%---------------------------------------------------------------------- %% Include files %%---------------------------------------------------------------------- --include("test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("snmp_test_lib.hrl"). diff --git a/lib/snmp/test/snmp_manager_user_old.erl b/lib/snmp/test/snmp_manager_user_old.erl index 0f0f026eca..f317fa831c 100644 --- a/lib/snmp/test/snmp_manager_user_old.erl +++ b/lib/snmp/test/snmp_manager_user_old.erl @@ -30,7 +30,7 @@ %%---------------------------------------------------------------------- %% Include files %%---------------------------------------------------------------------- --include("test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("snmp_test_lib.hrl"). diff --git a/lib/snmp/test/snmp_manager_user_test.erl b/lib/snmp/test/snmp_manager_user_test.erl index a0cdcdef4d..64edfef4d5 100644 --- a/lib/snmp/test/snmp_manager_user_test.erl +++ b/lib/snmp/test/snmp_manager_user_test.erl @@ -27,7 +27,7 @@ %%---------------------------------------------------------------------- %% Include files %%---------------------------------------------------------------------- --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("snmp_test_lib.hrl"). diff --git a/lib/snmp/test/snmp_manager_user_test_lib.erl b/lib/snmp/test/snmp_manager_user_test_lib.erl index a547f78efb..ea2c83a0da 100644 --- a/lib/snmp/test/snmp_manager_user_test_lib.erl +++ b/lib/snmp/test/snmp_manager_user_test_lib.erl @@ -30,7 +30,7 @@ %%---------------------------------------------------------------------- %% Include files %%---------------------------------------------------------------------- --include("test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("snmp_test_lib.hrl"). diff --git a/lib/ssh/doc/src/notes.xml b/lib/ssh/doc/src/notes.xml index 8fb689fdd5..75e1615c09 100644 --- a/lib/ssh/doc/src/notes.xml +++ b/lib/ssh/doc/src/notes.xml @@ -30,6 +30,24 @@ <file>notes.xml</file> </header> +<section><title>Ssh 4.2.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + The authentication method 'keyboard-interactive' failed + in the Erlang client when the server after successful + authentication continued by asking for zero more + passwords.</p> + <p> + Own Id: OTP-13225</p> + </item> + </list> + </section> + +</section> + <section><title>Ssh 4.2</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/ssh/src/ssh_auth.erl b/lib/ssh/src/ssh_auth.erl index fdbb5c152a..b71bed033a 100644 --- a/lib/ssh/src/ssh_auth.erl +++ b/lib/ssh/src/ssh_auth.erl @@ -477,7 +477,7 @@ keyboard_interact_get_responses(_, undefined, Password, _, _, _, _, _, 1) when Password =/= undefined -> [Password]; %% Password auth implemented with keyboard-interaction and passwd is known keyboard_interact_get_responses(_, _, _, _, _, _, _, _, 0) -> - [""]; + []; keyboard_interact_get_responses(false, undefined, undefined, _, _, _, [Prompt|_], Opts, _) -> ssh_no_io:read_line(Prompt, Opts); %% Throws error as keyboard interaction is not allowed keyboard_interact_get_responses(true, undefined, _,IoCb, Name, Instr, PromptInfos, Opts, _) -> diff --git a/lib/ssh/src/ssh_bits.erl b/lib/ssh/src/ssh_bits.erl index 4da3a6018b..101bf76cd3 100644 --- a/lib/ssh/src/ssh_bits.erl +++ b/lib/ssh/src/ssh_bits.erl @@ -26,52 +26,30 @@ -include("ssh.hrl"). --export([encode/2]). --export([mpint/1, string/1, name_list/1]). +-export([mpint/1, name_list/1]). -export([random/1]). --define(name_list(X), - (fun(B) -> ?binary(B) end)(list_to_binary(name_concat(X)))). - - -name_concat([Name]) when is_atom(Name) -> atom_to_list(Name); -name_concat([Name]) when is_list(Name) -> Name; -name_concat([Name|Ns]) -> - if is_atom(Name) -> - [atom_to_list(Name),"," | name_concat(Ns)]; - is_list(Name) -> - [Name,"," | name_concat(Ns)] - end; -name_concat([]) -> []. - - -name_list(Ns) -> - ?name_list(Ns). +%%%---------------------------------------------------------------- +name_list([Name]) -> to_bin(Name); +name_list([Name|Ns]) -> <<(to_bin(Name))/binary, ",", (name_list(Ns))/binary>>; +name_list([]) -> <<>>. + +to_bin(A) when is_atom(A) -> list_to_binary(atom_to_list(A)); +to_bin(S) when is_list(S) -> list_to_binary(S); +to_bin(B) when is_binary(B) -> B. + +%%%---------------------------------------------------------------- +%%% Multi Precision Integer encoding +mpint(-1) -> <<0,0,0,1,16#ff>>; +mpint(0) -> <<0,0,0,0>>; +mpint(X) when X < 0 -> mpint_neg(X,0,[]); +mpint(X) -> mpint_pos(X,0,[]). - -string(Str) -> - ?string(Str). - - -%% MP representaion (SSH2) -mpint(X) when X < 0 -> - if X == -1 -> - <<0,0,0,1,16#ff>>; - true -> - mpint_neg(X,0,[]) - end; -mpint(X) -> - if X == 0 -> - <<0,0,0,0>>; - true -> - mpint_pos(X,0,[]) - end. - mpint_neg(-1,I,Ds=[MSB|_]) -> if MSB band 16#80 =/= 16#80 -> <<?UINT32((I+1)), (list_to_binary([255|Ds]))/binary>>; true -> - (<<?UINT32(I), (list_to_binary(Ds))/binary>>) + <<?UINT32(I), (list_to_binary(Ds))/binary>> end; mpint_neg(X,I,Ds) -> mpint_neg(X bsr 8,I+1,[(X band 255)|Ds]). @@ -80,96 +58,17 @@ mpint_pos(0,I,Ds=[MSB|_]) -> if MSB band 16#80 == 16#80 -> <<?UINT32((I+1)), (list_to_binary([0|Ds]))/binary>>; true -> - (<<?UINT32(I), (list_to_binary(Ds))/binary>>) + <<?UINT32(I), (list_to_binary(Ds))/binary>> end; mpint_pos(X,I,Ds) -> mpint_pos(X bsr 8,I+1,[(X band 255)|Ds]). -encode(List, Types) -> - list_to_binary(enc(List, Types)). - -%% -%% Encode record element -%% -enc(Xs, Ts) -> - enc(Xs, Ts, 0). - -enc(Xs, [boolean|Ts], Offset) -> - X = hd(Xs), - [?boolean(X) | enc(tl(Xs), Ts, Offset+1)]; -enc(Xs, [byte|Ts], Offset) -> - X = hd(Xs), - [?byte(X) | enc(tl(Xs), Ts,Offset+1)]; -enc(Xs, [uint16|Ts], Offset) -> - X = hd(Xs), - [?uint16(X) | enc(tl(Xs), Ts,Offset+2)]; -enc(Xs, [uint32 |Ts], Offset) -> - X = hd(Xs), - [?uint32(X) | enc(tl(Xs), Ts,Offset+4)]; -enc(Xs, [uint64|Ts], Offset) -> - X = hd(Xs), - [?uint64(X) | enc(tl(Xs), Ts,Offset+8)]; -enc(Xs, [mpint|Ts], Offset) -> - Y = mpint(hd(Xs)), - [Y | enc(tl(Xs), Ts,Offset+size(Y))]; -enc(Xs, [string|Ts], Offset) -> - X0 = hd(Xs), - Y = ?string(X0), - [Y | enc(tl(Xs),Ts,Offset+size(Y))]; -enc(Xs, [string_utf8|Ts], Offset) -> - X0 = hd(Xs), - Y = ?string_utf8(X0), - [Y | enc(tl(Xs),Ts,Offset+size(Y))]; -enc(Xs, [binary|Ts], Offset) -> - X0 = hd(Xs), - Y = ?binary(X0), - [Y | enc(tl(Xs), Ts,Offset+size(Y))]; -enc(Xs, [name_list|Ts], Offset) -> - X0 = hd(Xs), - Y = ?name_list(X0), - [Y | enc(tl(Xs), Ts, Offset+size(Y))]; -enc(Xs, [cookie|Ts], Offset) -> - [random(16) | enc(tl(Xs), Ts, Offset+16)]; -enc(Xs, [{pad,N}|Ts], Offset) -> - K = (N - (Offset rem N)) rem N, - [fill_bits(K,0) | enc(Xs, Ts, Offset+K)]; -enc(Xs, ['...'| []], _Offset) -> - X = hd(Xs), - if is_binary(X) -> - [X]; - is_list(X) -> - [list_to_binary(X)]; - X==undefined -> - [] - end; -enc([], [],_) -> - []. - - -%% -%% Create a binary with constant bytes -%% -fill_bits(N,C) -> - list_to_binary(fill(N,C)). - -fill(0,_C) -> []; -fill(1,C) -> [C]; -fill(N,C) -> - Cs = fill(N div 2, C), - Cs1 = [Cs,Cs], - if N band 1 == 0 -> - Cs1; - true -> - [C,Cs,Cs] - end. - - +%%%---------------------------------------------------------------- %% random/1 %% Generate N random bytes %% -random(N) -> - crypto:strong_rand_bytes(N). +random(N) -> crypto:strong_rand_bytes(N). diff --git a/lib/ssh/src/ssh_connect.hrl b/lib/ssh/src/ssh_connect.hrl index 9f9f3de8fa..0c9ddad641 100644 --- a/lib/ssh/src/ssh_connect.hrl +++ b/lib/ssh/src/ssh_connect.hrl @@ -24,8 +24,9 @@ -type channel_id() :: integer(). --define(DEFAULT_PACKET_SIZE, 32768). --define(DEFAULT_WINDOW_SIZE, 2*?DEFAULT_PACKET_SIZE). +-define(DEFAULT_PACKET_SIZE, 65536). +-define(DEFAULT_WINDOW_SIZE, 10*?DEFAULT_PACKET_SIZE). + -define(DEFAULT_TIMEOUT, 5000). -define(MAX_PROTO_VERSION, 255). diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index f082db136c..ce1931e4f4 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -648,10 +648,12 @@ userauth_keyboard_interactive(Msg = #ssh_msg_userauth_failure{}, userauth_keyboard_interactive_info_response(Msg=#ssh_msg_userauth_failure{}, #state{ssh_params = #ssh{role = client}} = State) -> userauth(Msg, State); - userauth_keyboard_interactive_info_response(Msg=#ssh_msg_userauth_success{}, #state{ssh_params = #ssh{role = client}} = State) -> - userauth(Msg, State). + userauth(Msg, State); +userauth_keyboard_interactive_info_response(Msg=#ssh_msg_userauth_info_request{}, + #state{ssh_params = #ssh{role = client}} = State) -> + userauth_keyboard_interactive(Msg, State). %%-------------------------------------------------------------------- -spec connected({#ssh_msg_kexinit{}, binary()}, %%| %% #ssh_msg_kexdh_init{}, diff --git a/lib/ssh/src/ssh_message.erl b/lib/ssh/src/ssh_message.erl index b6c4496be2..a0e9a4961c 100644 --- a/lib/ssh/src/ssh_message.erl +++ b/lib/ssh/src/ssh_message.erl @@ -32,16 +32,44 @@ -export([encode/1, decode/1, decode_keyboard_interactive_prompts/2]). +-define('2bin'(X), (if is_binary(X) -> X; + is_list(X) -> list_to_binary(X); + X==undefined -> <<>> + end) ). + +-define('E...'(X), ?'2bin'(X)/binary ). +-define(Eboolean(X), ?BOOLEAN(case X of + true -> ?TRUE; + false -> ?FALSE + end) ). +-define(Ebyte(X), ?BYTE(X) ). +-define(Euint32(X), ?UINT32(X) ). +-define(Estring(X), ?STRING(?'2bin'(X)) ). +-define(Estring_utf8(X), ?string_utf8(X)/binary ). +-define(Ename_list(X), ?STRING(ssh_bits:name_list(X)) ). +-define(Empint(X), (ssh_bits:mpint(X))/binary ). +-define(Ebinary(X), ?STRING(X) ). + +%% encode(Msg) -> +%% try encode1(Msg) +%% catch +%% C:E -> +%% io:format('***********************~n~p:~p ~p~n',[C,E,Msg]), +%% error(E) +%% end. + encode(#ssh_msg_global_request{ name = Name, want_reply = Bool, data = Data}) -> - ssh_bits:encode([?SSH_MSG_GLOBAL_REQUEST, - Name, Bool, Data], [byte, string, boolean, '...']); + <<?Ebyte(?SSH_MSG_GLOBAL_REQUEST), ?Estring(Name), ?Eboolean(Bool), ?'E...'(Data)>>; + encode(#ssh_msg_request_success{data = Data}) -> - <<?BYTE(?SSH_MSG_REQUEST_SUCCESS), Data/binary>>; + <<?Ebyte(?SSH_MSG_REQUEST_SUCCESS), Data/binary>>; + encode(#ssh_msg_request_failure{}) -> - <<?BYTE(?SSH_MSG_REQUEST_FAILURE)>>; + <<?Ebyte(?SSH_MSG_REQUEST_FAILURE)>>; + encode(#ssh_msg_channel_open{ channel_type = Type, sender_channel = Sender, @@ -49,9 +77,8 @@ encode(#ssh_msg_channel_open{ maximum_packet_size = Max, data = Data }) -> - ssh_bits:encode([?SSH_MSG_CHANNEL_OPEN, - Type, Sender, Window, Max, Data], [byte, string, uint32, - uint32, uint32, '...']); + <<?Ebyte(?SSH_MSG_CHANNEL_OPEN), ?Estring(Type), ?Euint32(Sender), ?Euint32(Window), ?Euint32(Max), ?'E...'(Data)>>; + encode(#ssh_msg_channel_open_confirmation{ recipient_channel = Recipient, sender_channel = Sender, @@ -59,60 +86,63 @@ encode(#ssh_msg_channel_open_confirmation{ maximum_packet_size = MaxPacketSize, data = Data }) -> - ssh_bits:encode([?SSH_MSG_CHANNEL_OPEN_CONFIRMATION, Recipient, - Sender, InitWindowSize, MaxPacketSize, Data], - [byte, uint32, uint32, uint32, uint32, '...']); + <<?Ebyte(?SSH_MSG_CHANNEL_OPEN_CONFIRMATION), + ?Euint32(Recipient), ?Euint32(Sender), ?Euint32(InitWindowSize), ?Euint32(MaxPacketSize), + ?'E...'(Data)>>; + encode(#ssh_msg_channel_open_failure{ recipient_channel = Recipient, reason = Reason, description = Desc, lang = Lang }) -> - ssh_bits:encode([?SSH_MSG_CHANNEL_OPEN_FAILURE, Recipient, - Reason, Desc, Lang], [byte, uint32, uint32, string, string]); + <<?Ebyte(?SSH_MSG_CHANNEL_OPEN_FAILURE), ?Euint32(Recipient),?Euint32(Reason), ?Estring(Desc), ?Estring(Lang)>>; + encode(#ssh_msg_channel_window_adjust{ recipient_channel = Recipient, bytes_to_add = Bytes }) -> - ssh_bits:encode([?SSH_MSG_CHANNEL_WINDOW_ADJUST, Recipient, Bytes], - [byte, uint32, uint32]); + <<?Ebyte(?SSH_MSG_CHANNEL_WINDOW_ADJUST), ?Euint32(Recipient), ?Euint32(Bytes)>>; + encode(#ssh_msg_channel_data{ recipient_channel = Recipient, data = Data }) -> - ssh_bits:encode([?SSH_MSG_CHANNEL_DATA, Recipient, Data], [byte, uint32, binary]); + <<?Ebyte(?SSH_MSG_CHANNEL_DATA), ?Euint32(Recipient), ?Ebinary(Data)>>; encode(#ssh_msg_channel_extended_data{ recipient_channel = Recipient, data_type_code = DataType, data = Data }) -> - ssh_bits:encode([?SSH_MSG_CHANNEL_EXTENDED_DATA, Recipient, - DataType, Data], [byte, uint32, uint32, binary]); + <<?Ebyte(?SSH_MSG_CHANNEL_EXTENDED_DATA), ?Euint32(Recipient), ?Euint32(DataType), ?Ebinary(Data)>>; encode(#ssh_msg_channel_eof{recipient_channel = Recipient }) -> - <<?BYTE(?SSH_MSG_CHANNEL_EOF), ?UINT32(Recipient)>>; + <<?Ebyte(?SSH_MSG_CHANNEL_EOF), ?Euint32(Recipient)>>; + encode(#ssh_msg_channel_close{ recipient_channel = Recipient }) -> - <<?BYTE(?SSH_MSG_CHANNEL_CLOSE), ?UINT32(Recipient)>>; + <<?Ebyte(?SSH_MSG_CHANNEL_CLOSE), ?Euint32(Recipient)>>; + encode(#ssh_msg_channel_request{ recipient_channel = Recipient, request_type = Type, want_reply = Bool, data = Data }) -> - ssh_bits:encode([?SSH_MSG_CHANNEL_REQUEST, Recipient, Type, Bool, Data], - [byte, uint32, string, boolean, '...']); + <<?Ebyte(?SSH_MSG_CHANNEL_REQUEST), ?Euint32(Recipient), ?Estring(Type), ?Eboolean(Bool), ?'E...'(Data)>>; + encode(#ssh_msg_channel_success{ recipient_channel = Recipient }) -> - <<?BYTE(?SSH_MSG_CHANNEL_SUCCESS), ?UINT32(Recipient)>>; + <<?Ebyte(?SSH_MSG_CHANNEL_SUCCESS), ?Euint32(Recipient)>>; + encode(#ssh_msg_channel_failure{ recipient_channel = Recipient }) -> - <<?BYTE(?SSH_MSG_CHANNEL_FAILURE), ?UINT32(Recipient)>>; + <<?Ebyte(?SSH_MSG_CHANNEL_FAILURE), ?Euint32(Recipient)>>; encode(#ssh_msg_userauth_request{ user = User, @@ -120,36 +150,33 @@ encode(#ssh_msg_userauth_request{ method = Method, data = Data }) -> - ssh_bits:encode([?SSH_MSG_USERAUTH_REQUEST, User, Service, Method, Data], - [byte, string_utf8, string, string, '...']); + <<?Ebyte(?SSH_MSG_USERAUTH_REQUEST), ?Estring_utf8(User), ?Estring(Service), ?Estring(Method), ?'E...'(Data)>>; + encode(#ssh_msg_userauth_failure{ authentications = Auths, partial_success = Bool }) -> - ssh_bits:encode([?SSH_MSG_USERAUTH_FAILURE, Auths, Bool], - [byte, string, boolean]); + <<?Ebyte(?SSH_MSG_USERAUTH_FAILURE), ?Estring(Auths), ?Eboolean(Bool)>>; + encode(#ssh_msg_userauth_success{}) -> - <<?BYTE(?SSH_MSG_USERAUTH_SUCCESS)>>; + <<?Ebyte(?SSH_MSG_USERAUTH_SUCCESS)>>; encode(#ssh_msg_userauth_banner{ message = Banner, language = Lang }) -> - ssh_bits:encode([?SSH_MSG_USERAUTH_BANNER, Banner, Lang], - [byte, string_utf8, string]); + <<?Ebyte(?SSH_MSG_USERAUTH_BANNER), ?Estring_utf8(Banner), ?Estring(Lang)>>; encode(#ssh_msg_userauth_pk_ok{ algorithm_name = Alg, key_blob = KeyBlob }) -> - ssh_bits:encode([?SSH_MSG_USERAUTH_PK_OK, Alg, KeyBlob], - [byte, string, binary]); + <<?Ebyte(?SSH_MSG_USERAUTH_PK_OK), ?Estring(Alg), ?Ebinary(KeyBlob)>>; encode(#ssh_msg_userauth_passwd_changereq{prompt = Prompt, languge = Lang })-> - ssh_bits:encode([?SSH_MSG_USERAUTH_PASSWD_CHANGEREQ, Prompt, Lang], - [byte, string, string]); + <<?Ebyte(?SSH_MSG_USERAUTH_PASSWD_CHANGEREQ), ?Estring(Prompt), ?Estring(Lang)>>; encode(#ssh_msg_userauth_info_request{ name = Name, @@ -157,41 +184,37 @@ encode(#ssh_msg_userauth_info_request{ language_tag = Lang, num_prompts = NumPromtps, data = Data}) -> - ssh_bits:encode([?SSH_MSG_USERAUTH_INFO_REQUEST, Name, Inst, Lang, NumPromtps, Data], - [byte, string, string, string, uint32, '...']); + <<?Ebyte(?SSH_MSG_USERAUTH_INFO_REQUEST), ?Estring(Name), ?Estring(Inst), ?Estring(Lang), + ?Euint32(NumPromtps), ?'E...'(Data)>>; encode(#ssh_msg_userauth_info_response{ num_responses = Num, data = Data}) -> - Responses = lists:map(fun("") -> - <<>>; - (Response) -> - ssh_bits:encode([Response], [string]) - end, Data), - Start = ssh_bits:encode([?SSH_MSG_USERAUTH_INFO_RESPONSE, Num], - [byte, uint32]), - iolist_to_binary([Start, Responses]); + lists:foldl(fun %%("", Acc) -> Acc; % commented out since it seem wrong + (Response, Acc) -> <<Acc/binary, ?Estring(Response)>> + end, + <<?Ebyte(?SSH_MSG_USERAUTH_INFO_RESPONSE), ?Euint32(Num)>>, + Data); encode(#ssh_msg_disconnect{ code = Code, description = Desc, language = Lang }) -> - ssh_bits:encode([?SSH_MSG_DISCONNECT, Code, Desc, Lang], - [byte, uint32, string, string]); + <<?Ebyte(?SSH_MSG_DISCONNECT), ?Euint32(Code), ?Estring(Desc), ?Estring(Lang)>>; encode(#ssh_msg_service_request{ name = Service }) -> - ssh_bits:encode([?SSH_MSG_SERVICE_REQUEST, Service], [byte, string]); + <<?Ebyte(?SSH_MSG_SERVICE_REQUEST), ?Estring(Service)>>; encode(#ssh_msg_service_accept{ name = Service }) -> - ssh_bits:encode([?SSH_MSG_SERVICE_ACCEPT, Service], [byte, string]); + <<?Ebyte(?SSH_MSG_SERVICE_ACCEPT), ?Estring(Service)>>; encode(#ssh_msg_newkeys{}) -> - <<?BYTE(?SSH_MSG_NEWKEYS)>>; + <<?Ebyte(?SSH_MSG_NEWKEYS)>>; encode(#ssh_msg_kexinit{ cookie = Cookie, @@ -208,19 +231,13 @@ encode(#ssh_msg_kexinit{ first_kex_packet_follows = Bool, reserved = Reserved }) -> - ssh_bits:encode([?SSH_MSG_KEXINIT, Cookie, KeyAlgs, HostKeyAlgs, EncAlgC2S, EncAlgS2C, - MacAlgC2S, MacAlgS2C, CompAlgS2C, CompAlgC2S, LangC2S, LangS2C, Bool, - Reserved], - [byte, cookie, - name_list, name_list, - name_list, name_list, - name_list, name_list, - name_list, name_list, - name_list, name_list, - boolean, uint32]); + <<?Ebyte(?SSH_MSG_KEXINIT), Cookie/binary, + ?Ename_list(KeyAlgs), ?Ename_list(HostKeyAlgs), ?Ename_list(EncAlgC2S), ?Ename_list(EncAlgS2C), ?Ename_list(MacAlgC2S), + ?Ename_list(MacAlgS2C), ?Ename_list(CompAlgS2C), ?Ename_list(CompAlgC2S), ?Ename_list(LangC2S), ?Ename_list(LangS2C), + ?Eboolean(Bool), ?Euint32(Reserved)>>; encode(#ssh_msg_kexdh_init{e = E}) -> - ssh_bits:encode([?SSH_MSG_KEXDH_INIT, E], [byte, mpint]); + <<?Ebyte(?SSH_MSG_KEXDH_INIT), ?Empint(E)>>; encode(#ssh_msg_kexdh_reply{ public_host_key = Key, @@ -229,25 +246,23 @@ encode(#ssh_msg_kexdh_reply{ }) -> EncKey = public_key:ssh_encode(Key, ssh2_pubkey), EncSign = encode_signature(Key, Signature), - ssh_bits:encode([?SSH_MSG_KEXDH_REPLY, EncKey, F, EncSign], [byte, binary, mpint, binary]); + <<?Ebyte(?SSH_MSG_KEXDH_REPLY), ?Ebinary(EncKey), ?Empint(F), ?Ebinary(EncSign)>>; encode(#ssh_msg_kex_dh_gex_request{ min = Min, n = N, max = Max }) -> - ssh_bits:encode([?SSH_MSG_KEX_DH_GEX_REQUEST, Min, N, Max], - [byte, uint32, uint32, uint32]); + <<?Ebyte(?SSH_MSG_KEX_DH_GEX_REQUEST), ?Euint32(Min), ?Euint32(N), ?Euint32(Max)>>; + encode(#ssh_msg_kex_dh_gex_request_old{n = N}) -> - ssh_bits:encode([?SSH_MSG_KEX_DH_GEX_REQUEST_OLD, N], - [byte, uint32]); + <<?Ebyte(?SSH_MSG_KEX_DH_GEX_REQUEST_OLD), ?Euint32(N)>>; encode(#ssh_msg_kex_dh_gex_group{p = Prime, g = Generator}) -> - ssh_bits:encode([?SSH_MSG_KEX_DH_GEX_GROUP, Prime, Generator], - [byte, mpint, mpint]); + <<?Ebyte(?SSH_MSG_KEX_DH_GEX_GROUP), ?Empint(Prime), ?Empint(Generator)>>; encode(#ssh_msg_kex_dh_gex_init{e = Public}) -> - ssh_bits:encode([?SSH_MSG_KEX_DH_GEX_INIT, Public], [byte, mpint]); + <<?Ebyte(?SSH_MSG_KEX_DH_GEX_INIT), ?Empint(Public)>>; encode(#ssh_msg_kex_dh_gex_reply{ %% Will be private key encode_host_key extracts only the public part! @@ -257,26 +272,26 @@ encode(#ssh_msg_kex_dh_gex_reply{ }) -> EncKey = public_key:ssh_encode(Key, ssh2_pubkey), EncSign = encode_signature(Key, Signature), - ssh_bits:encode([?SSH_MSG_KEX_DH_GEX_REPLY, EncKey, F, EncSign], [byte, binary, mpint, binary]); + <<?Ebyte(?SSH_MSG_KEX_DH_GEX_REPLY), ?Ebinary(EncKey), ?Empint(F), ?Ebinary(EncSign)>>; encode(#ssh_msg_kex_ecdh_init{q_c = Q_c}) -> - ssh_bits:encode([?SSH_MSG_KEX_ECDH_INIT, Q_c], [byte, mpint]); + <<?Ebyte(?SSH_MSG_KEX_ECDH_INIT), ?Empint(Q_c)>>; encode(#ssh_msg_kex_ecdh_reply{public_host_key = Key, q_s = Q_s, h_sig = Sign}) -> EncKey = public_key:ssh_encode(Key, ssh2_pubkey), EncSign = encode_signature(Key, Sign), - ssh_bits:encode([?SSH_MSG_KEX_ECDH_REPLY, EncKey, Q_s, EncSign], [byte, binary, mpint, binary]); + <<?Ebyte(?SSH_MSG_KEX_ECDH_REPLY), ?Ebinary(EncKey), ?Empint(Q_s), ?Ebinary(EncSign)>>; encode(#ssh_msg_ignore{data = Data}) -> - ssh_bits:encode([?SSH_MSG_IGNORE, Data], [byte, string]); + <<?Ebyte(?SSH_MSG_IGNORE), ?Estring(Data)>>; encode(#ssh_msg_unimplemented{sequence = Seq}) -> - ssh_bits:encode([?SSH_MSG_UNIMPLEMENTED, Seq], [byte, uint32]); + <<?Ebyte(?SSH_MSG_UNIMPLEMENTED), ?Euint32(Seq)>>; encode(#ssh_msg_debug{always_display = Bool, message = Msg, language = Lang}) -> - ssh_bits:encode([?SSH_MSG_DEBUG, Bool, Msg, Lang], [byte, boolean, string, string]). + <<?Ebyte(?SSH_MSG_DEBUG), ?Eboolean(Bool), ?Estring(Msg), ?Estring(Lang)>>. %% Connection Messages @@ -553,10 +568,10 @@ decode_signature(<<?DEC_BIN(_Alg,__0), ?UINT32(_), Signature/binary>>) -> encode_signature(#'RSAPublicKey'{}, Signature) -> - ssh_bits:encode(["ssh-rsa", Signature],[string, binary]); + <<?Ebinary(<<"ssh-rsa">>), ?Ebinary(Signature)>>; encode_signature({_, #'Dss-Parms'{}}, Signature) -> - ssh_bits:encode(["ssh-dss", Signature],[string, binary]); + <<?Ebinary(<<"ssh-dss">>), ?Ebinary(Signature)>>; encode_signature({#'ECPoint'{}, {namedCurve,OID}}, Signature) -> CurveName = public_key:oid2ssh_curvename(OID), - ssh_bits:encode([<<"ecdsa-sha2-",CurveName/binary>>, Signature], [binary,binary]). + <<?Ebinary(<<"ecdsa-sha2-",CurveName/binary>>), ?Ebinary(Signature)>>. diff --git a/lib/ssh/src/ssh_sftp.erl b/lib/ssh/src/ssh_sftp.erl index dbacf730cc..eb99406626 100644 --- a/lib/ssh/src/ssh_sftp.erl +++ b/lib/ssh/src/ssh_sftp.erl @@ -99,8 +99,8 @@ start_channel(Host) when is_list(Host) -> start_channel(Host, []). start_channel(Cm, Opts) when is_pid(Cm) -> Timeout = proplists:get_value(timeout, Opts, infinity), - {_, SftpOpts} = handle_options(Opts, [], []), - case ssh_xfer:attach(Cm, []) of + {_, ChanOpts, SftpOpts} = handle_options(Opts, [], [], []), + case ssh_xfer:attach(Cm, [], ChanOpts) of {ok, ChannelId, Cm} -> case ssh_channel:start(Cm, ChannelId, ?MODULE, [Cm, ChannelId, SftpOpts]) of @@ -123,9 +123,9 @@ start_channel(Cm, Opts) when is_pid(Cm) -> start_channel(Host, Opts) -> start_channel(Host, 22, Opts). start_channel(Host, Port, Opts) -> - {SshOpts, SftpOpts} = handle_options(Opts, [], []), + {SshOpts, ChanOpts, SftpOpts} = handle_options(Opts, [], [], []), Timeout = proplists:get_value(timeout, SftpOpts, infinity), - case ssh_xfer:connect(Host, Port, SshOpts, Timeout) of + case ssh_xfer:connect(Host, Port, SshOpts, ChanOpts, Timeout) of {ok, ChannelId, Cm} -> case ssh_channel:start(Cm, ChannelId, ?MODULE, [Cm, ChannelId, SftpOpts]) of @@ -842,14 +842,18 @@ terminate(_Reason, State) -> %%==================================================================== %% Internal functions %%==================================================================== -handle_options([], Sftp, Ssh) -> - {Ssh, Sftp}; -handle_options([{timeout, _} = Opt | Rest], Sftp, Ssh) -> - handle_options(Rest, [Opt | Sftp], Ssh); -handle_options([{sftp_vsn, _} = Opt| Rest], Sftp, Ssh) -> - handle_options(Rest, [Opt | Sftp], Ssh); -handle_options([Opt | Rest], Sftp, Ssh) -> - handle_options(Rest, Sftp, [Opt | Ssh]). +handle_options([], Sftp, Chan, Ssh) -> + {Ssh, Chan, Sftp}; +handle_options([{timeout, _} = Opt | Rest], Sftp, Chan, Ssh) -> + handle_options(Rest, [Opt|Sftp], Chan, Ssh); +handle_options([{sftp_vsn, _} = Opt| Rest], Sftp, Chan, Ssh) -> + handle_options(Rest, [Opt|Sftp], Chan, Ssh); +handle_options([{window_size, _} = Opt| Rest], Sftp, Chan, Ssh) -> + handle_options(Rest, Sftp, [Opt|Chan], Ssh); +handle_options([{packet_size, _} = Opt| Rest], Sftp, Chan, Ssh) -> + handle_options(Rest, Sftp, [Opt|Chan], Ssh); +handle_options([Opt|Rest], Sftp, Chan, Ssh) -> + handle_options(Rest, Sftp, Chan, [Opt|Ssh]). call(Pid, Msg, TimeOut) -> ssh_channel:call(Pid, {{timeout, TimeOut}, Msg}, infinity). diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index 18037b8461..a648c7af3d 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -52,6 +52,14 @@ -export([pack/3]). -export([decompress/2, decrypt_blocks/3, is_valid_mac/3 ]). % FIXME: remove +-define(Estring(X), ?STRING((if is_binary(X) -> X; + is_list(X) -> list_to_binary(X); + X==undefined -> <<>> + end))). +-define(Empint(X), (ssh_bits:mpint(X))/binary ). +-define(Ebinary(X), ?STRING(X) ). +-define(Euint32(X), ?UINT32(X) ). + %%%---------------------------------------------------------------------------- %%% %%% There is a difference between supported and default algorithms. The @@ -1084,7 +1092,7 @@ sign(SigData, Hash, #'DSAPrivateKey'{} = Key) -> sign(SigData, Hash, Key = #'ECPrivateKey'{}) -> DerEncodedSign = public_key:sign(SigData, Hash, Key), #'ECDSA-Sig-Value'{r=R, s=S} = public_key:der_decode('ECDSA-Sig-Value', DerEncodedSign), - ssh_bits:encode([R,S], [mpint,mpint]); + <<?Empint(R),?Empint(S)>>; sign(SigData, Hash, Key) -> public_key:sign(SigData, Hash, Key). @@ -1584,21 +1592,16 @@ hash(K, H, Ki, N, HASH) -> kex_h(SSH, Key, E, F, K) -> KeyBin = public_key:ssh_encode(Key, ssh2_pubkey), - L = ssh_bits:encode([SSH#ssh.c_version, SSH#ssh.s_version, - SSH#ssh.c_keyinit, SSH#ssh.s_keyinit, - KeyBin, E,F,K], - [string,string,binary,binary,binary, - mpint,mpint,mpint]), + L = <<?Estring(SSH#ssh.c_version), ?Estring(SSH#ssh.s_version), + ?Ebinary(SSH#ssh.c_keyinit), ?Ebinary(SSH#ssh.s_keyinit), ?Ebinary(KeyBin), + ?Empint(E), ?Empint(F), ?Empint(K)>>, crypto:hash(sha((SSH#ssh.algorithms)#alg.kex), L). -%% crypto:hash(sha,L). kex_h(SSH, Curve, Key, Q_c, Q_s, K) -> KeyBin = public_key:ssh_encode(Key, ssh2_pubkey), - L = ssh_bits:encode([SSH#ssh.c_version, SSH#ssh.s_version, - SSH#ssh.c_keyinit, SSH#ssh.s_keyinit, - KeyBin, Q_c, Q_s, K], - [string,string,binary,binary,binary, - mpint,mpint,mpint]), + L = <<?Estring(SSH#ssh.c_version), ?Estring(SSH#ssh.s_version), + ?Ebinary(SSH#ssh.c_keyinit), ?Ebinary(SSH#ssh.s_keyinit), ?Ebinary(KeyBin), + ?Empint(Q_c), ?Empint(Q_s), ?Empint(K)>>, crypto:hash(sha(Curve), L). kex_h(SSH, Key, Min, NBits, Max, Prime, Gen, E, F, K) -> @@ -1607,21 +1610,14 @@ kex_h(SSH, Key, Min, NBits, Max, Prime, Gen, E, F, K) -> %% flag from 'ssh_msg_kex_dh_gex_request_old' %% It was like this before that message was supported, %% why? - Ts = [string,string,binary,binary,binary, - uint32, - mpint,mpint,mpint,mpint,mpint], - ssh_bits:encode([SSH#ssh.c_version,SSH#ssh.s_version, - SSH#ssh.c_keyinit,SSH#ssh.s_keyinit, - KeyBin, NBits, Prime, Gen, E,F,K], - Ts); + <<?Estring(SSH#ssh.c_version), ?Estring(SSH#ssh.s_version), + ?Ebinary(SSH#ssh.c_keyinit), ?Ebinary(SSH#ssh.s_keyinit), ?Ebinary(KeyBin), + ?Empint(E), ?Empint(F), ?Empint(K)>>; true -> - Ts = [string,string,binary,binary,binary, - uint32,uint32,uint32, - mpint,mpint,mpint,mpint,mpint], - ssh_bits:encode([SSH#ssh.c_version,SSH#ssh.s_version, - SSH#ssh.c_keyinit,SSH#ssh.s_keyinit, - KeyBin, Min, NBits, Max, - Prime, Gen, E,F,K], Ts) + <<?Estring(SSH#ssh.c_version), ?Estring(SSH#ssh.s_version), + ?Ebinary(SSH#ssh.c_keyinit), ?Ebinary(SSH#ssh.s_keyinit), ?Ebinary(KeyBin), + ?Euint32(Min), ?Euint32(NBits), ?Euint32(Max), + ?Empint(Prime), ?Empint(Gen), ?Empint(E), ?Empint(F), ?Empint(K)>> end, crypto:hash(sha((SSH#ssh.algorithms)#alg.kex), L). diff --git a/lib/ssh/src/ssh_xfer.erl b/lib/ssh/src/ssh_xfer.erl index b8dff1c533..259dc71aa5 100644 --- a/lib/ssh/src/ssh_xfer.erl +++ b/lib/ssh/src/ssh_xfer.erl @@ -24,7 +24,7 @@ -module(ssh_xfer). --export([attach/2, connect/3, connect/4]). +-export([attach/2, attach/3, connect/3, connect/4, connect/5]). -export([open/6, opendir/3, readdir/3, close/3, read/5, write/5, rename/5, remove/3, mkdir/4, rmdir/3, realpath/3, extended/4, stat/4, fstat/4, lstat/4, setstat/4, @@ -47,28 +47,38 @@ -define(is_set(F, Bits), ((F) band (Bits)) == (F)). --define(XFER_PACKET_SIZE, 32768). --define(XFER_WINDOW_SIZE, 4*?XFER_PACKET_SIZE). +-define(XFER_PACKET_SIZE, 65536). +-define(XFER_WINDOW_SIZE, 20*?XFER_PACKET_SIZE). attach(CM, Opts) -> - open_xfer(CM, Opts). + open_xfer(CM, Opts, []). + +attach(CM, Opts, ChanOpts) -> + open_xfer(CM, Opts, ChanOpts). + connect(Host, Port, Opts) -> case ssh:connect(Host, Port, Opts) of - {ok, CM} -> open_xfer(CM, Opts); + {ok, CM} -> open_xfer(CM, Opts, []); Error -> Error end. connect(Host, Port, Opts, Timeout) -> + connect(Host, Port, Opts, [], Timeout). + +connect(Host, Port, Opts, ChanOpts, Timeout) -> case ssh:connect(Host, Port, Opts, Timeout) of - {ok, CM} -> open_xfer(CM, [{timeout, Timeout}|Opts]); + {ok, CM} -> open_xfer(CM, [{timeout, Timeout}|Opts], ChanOpts); {error, Timeout} -> {error, timeout}; Error -> Error end. -open_xfer(CM, Opts) -> + +open_xfer(CM, Opts, ChanOpts) -> TMO = proplists:get_value(timeout, Opts, infinity), - case ssh_connection:session_channel(CM, ?XFER_WINDOW_SIZE, ?XFER_PACKET_SIZE, TMO) of + WindowSize = proplists:get_value(window_size, ChanOpts, ?XFER_WINDOW_SIZE), + PacketSize = proplists:get_value(packet_size, ChanOpts, ?XFER_PACKET_SIZE), + case ssh_connection:session_channel(CM, WindowSize, PacketSize, TMO) of {ok, ChannelId} -> {ok, ChannelId, CM}; Error -> diff --git a/lib/ssh/test/Makefile b/lib/ssh/test/Makefile index 781a876723..fb539f98fa 100644 --- a/lib/ssh/test/Makefile +++ b/lib/ssh/test/Makefile @@ -35,9 +35,8 @@ MODULES= \ ssh_algorithms_SUITE \ ssh_options_SUITE \ ssh_renegotiate_SUITE \ - \ ssh_basic_SUITE \ - \ + ssh_benchmark_SUITE \ ssh_connection_SUITE \ ssh_protocol_SUITE \ ssh_sftp_SUITE \ @@ -65,8 +64,7 @@ TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) DATA_DIRS = $(MODULES:%=%_data) -INCLUDES = -I$(ERL_TOP)/lib/test_server/include \ - -I$(ERL_TOP)/lib/ssh/src \ +INCLUDES = -I$(ERL_TOP)/lib/ssh/src EMAKEFILE=Emakefile MAKE_EMAKE = $(wildcard $(ERL_TOP)/make/make_emakefile) @@ -89,8 +87,7 @@ RELSYSDIR = $(RELEASE_PATH)/ssh_test # The path to the test_server ebin dir is needed when # running the target "targets". # ---------------------------------------------------- -ERL_COMPILE_FLAGS += -pa ../../../internal_tools/test_server/ebin \ - $(INCLUDES) +ERL_COMPILE_FLAGS += $(INCLUDES) EBIN = . @@ -129,7 +126,7 @@ release_spec: opt release_tests_spec: opt $(INSTALL_DIR) "$(RELSYSDIR)" $(INSTALL_DATA) $(ERL_FILES) "$(RELSYSDIR)" - $(INSTALL_DATA) ssh.spec ssh.cover "$(RELSYSDIR)" + $(INSTALL_DATA) ssh.spec ssh_bench.spec ssh.cover "$(RELSYSDIR)" $(INSTALL_DATA) $(HRL_FILES_NEEDED_IN_TEST) "$(RELSYSDIR)" chmod -R u+w "$(RELSYSDIR)" @tar cf - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -) diff --git a/lib/ssh/test/ssh.spec b/lib/ssh/test/ssh.spec index 8de0fe44e4..0076fc275e 100644 --- a/lib/ssh/test/ssh.spec +++ b/lib/ssh/test/ssh.spec @@ -1,7 +1,6 @@ {suites,"../ssh_test",all}. -{skip_cases,"../ssh_test",ssh_ssh_SUITE, - [ssh], - "Current implementation is timingdependent and\nhence will succeed/fail on a whim"}. -{skip_cases,"../ssh_test",ssh_ssh_SUITE, - [ssh_compressed], - "Current implementation is timingdependent hence will succeed/fail on a whim"}. + +{skip_suites, "../ssh_test", [ssh_benchmark_SUITE], + "Benchmarks run separately"}. + + diff --git a/lib/ssh/test/ssh_algorithms_SUITE.erl b/lib/ssh/test/ssh_algorithms_SUITE.erl index f0ac92fef6..a03a9ee0f2 100644 --- a/lib/ssh/test/ssh_algorithms_SUITE.erl +++ b/lib/ssh/test/ssh_algorithms_SUITE.erl @@ -35,7 +35,8 @@ %%-------------------------------------------------------------------- suite() -> - [{ct_hooks,[ts_install_cth]}]. + [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,5}}]. all() -> %% [{group,kex},{group,cipher}... etc @@ -90,18 +91,12 @@ init_per_suite(Config) -> ?MAX_NUM_ALGORITHMS ]), ct:log("all() ->~n ~p.~n~ngroups()->~n ~p.~n",[all(),groups()]), - catch crypto:stop(), - case catch crypto:start() of - ok -> - ssh:start(), - [{std_simple_sftp_size,25000} % Sftp transferred data size - | setup_pubkey(Config)]; - _Else -> - {skip, "Crypto could not be started!"} - end. + ssh:start(), + [{std_simple_sftp_size,25000} % Sftp transferred data size + | setup_pubkey(Config)]. + end_per_suite(_Config) -> - ssh:stop(), - crypto:stop(). + ssh:stop(). init_per_group(Group, Config) -> @@ -231,8 +226,11 @@ sshc_simple_exec(Config) -> " ",Host," 1+1."]), ct:log("~p",[Cmd]), SshPort = open_port({spawn, Cmd}, [binary]), + Expect = <<"2\n">>, receive - {SshPort,{data, <<"2\n">>}} -> + {SshPort, {data,Expect}} -> + ct:log("Got expected ~p from ~p",[Expect,SshPort]), + catch port_close(SshPort), ok after ?TIMEOUT -> ct:fail("Did not receive answer") @@ -273,7 +271,9 @@ sshd_simple_exec(_Config) -> ConnectionRef, ChannelId1); Other1 -> ct:fail(Other1) - end. + end, + ssh:close(ConnectionRef). + %%%================================================================ %%% diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl index 6c4c215b3d..564fb66586 100644 --- a/lib/ssh/test/ssh_basic_SUITE.erl +++ b/lib/ssh/test/ssh_basic_SUITE.erl @@ -78,7 +78,8 @@ %%-------------------------------------------------------------------- suite() -> - [{ct_hooks,[ts_install_cth]}]. + [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,5}}]. all() -> [app_test, @@ -129,16 +130,11 @@ basic_tests() -> %%-------------------------------------------------------------------- init_per_suite(Config) -> - catch crypto:stop(), - case catch crypto:start() of - ok -> - Config; - _Else -> - {skip, "Crypto could not be started!"} - end. + Config. + end_per_suite(_Config) -> - ssh:stop(), - crypto:stop(). + ssh:stop(). + %%-------------------------------------------------------------------- init_per_group(dsa_key, Config) -> DataDir = ?config(data_dir, Config), @@ -441,6 +437,7 @@ exec(Config) when is_list(Config) -> ct:fail(Other1) end, ssh_test_lib:receive_exec_end(ConnectionRef, ChannelId1), + ssh:close(ConnectionRef), ssh:stop_daemon(Pid). %%-------------------------------------------------------------------- @@ -474,6 +471,7 @@ exec_compressed(Config) when is_list(Config) -> ct:fail(Other) end, ssh_test_lib:receive_exec_end(ConnectionRef, ChannelId), + ssh:close(ConnectionRef), ssh:stop_daemon(Pid) end. @@ -601,10 +599,14 @@ cli(Config) when is_list(Config) -> process_flag(trap_exit, true), SystemDir = filename:join(?config(priv_dir, Config), system), UserDir = ?config(priv_dir, Config), - + + TmpDir = filename:join(?config(priv_dir,Config), "tmp"), + ok = ssh_test_lib:del_dirs(TmpDir), + ok = file:make_dir(TmpDir), + {_Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir},{user_dir, UserDir}, {password, "morot"}, - {ssh_cli, {ssh_test_cli, [cli]}}, + {ssh_cli, {ssh_test_cli, [cli,TmpDir]}}, {subsystems, []}, {failfun, fun ssh_test_lib:failfun/2}]), ct:sleep(500), @@ -975,7 +977,10 @@ shell_no_unicode(Config) -> new_do_shell(?config(io,Config), [new_prompt, {type,"io:format(\"hej ~p~n\",[42])."}, - {expect,"hej 42"} + {expect,"hej 42"}, + {expect,"ok"}, + new_prompt, + {type,"exit()."} ]). %%-------------------------------------------------------------------- @@ -984,7 +989,9 @@ shell_unicode_string(Config) -> [new_prompt, {type,"io:format(\"こにちわ~ts~n\",[\"四二\"])."}, {expect,"こにちわ四二"}, - {expect,"ok"} + {expect,"ok"}, + new_prompt, + {type,"exit()."} ]). %%-------------------------------------------------------------------- diff --git a/lib/ssh/test/ssh_bench.spec b/lib/ssh/test/ssh_bench.spec new file mode 100644 index 0000000000..029f0bd074 --- /dev/null +++ b/lib/ssh/test/ssh_bench.spec @@ -0,0 +1 @@ +{suites,"../ssh_test",[ssh_benchmark_SUITE]}. diff --git a/lib/ssh/test/ssh_benchmark_SUITE.erl b/lib/ssh/test/ssh_benchmark_SUITE.erl new file mode 100644 index 0000000000..fe90da3028 --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE.erl @@ -0,0 +1,536 @@ +%%%------------------------------------------------------------------- +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2015. 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_benchmark_SUITE). +-compile(export_all). + +-include_lib("common_test/include/ct_event.hrl"). +-include_lib("common_test/include/ct.hrl"). + +-include_lib("ssh/src/ssh.hrl"). +-include_lib("ssh/src/ssh_transport.hrl"). +-include_lib("ssh/src/ssh_connect.hrl"). +-include_lib("ssh/src/ssh_userauth.hrl"). + + +suite() -> [{ct_hooks,[{ts_install_cth,[{nodenames,2}]}]}]. +%%suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> [{group, opensshc_erld} +%% {group, erlc_opensshd} + ]. + +groups() -> + [{opensshc_erld, [{repeat, 3}], [openssh_client_shell, + openssh_client_sftp]} + ]. + + +init_per_suite(Config) -> + catch ssh:stop(), + try + report_client_algorithms(), + ok = ssh:start(), + {ok,TracerPid} = erlang_trace(), + [{tracer_pid,TracerPid} | init_sftp_dirs(Config)] + catch + C:E -> + {skip, io_lib:format("Couldn't start ~p:~p",[C,E])} + end. + +end_per_suite(_Config) -> + catch ssh:stop(), + ok. + + + +init_per_group(opensshc_erld, Config) -> + case ssh_test_lib:ssh_type() of + openSSH -> + DataDir = ?config(data_dir, Config), + UserDir = ?config(priv_dir, Config), + ssh_test_lib:setup_dsa(DataDir, UserDir), + ssh_test_lib:setup_rsa(DataDir, UserDir), + ssh_test_lib:setup_ecdsa("256", DataDir, UserDir), + Common = ssh_test_lib:intersect_bi_dir( + ssh_test_lib:intersection(ssh:default_algorithms(), + ssh_test_lib:default_algorithms(sshc))), + [{c_kexs, ssh_test_lib:sshc(kex)}, + {c_ciphers, ssh_test_lib:sshc(cipher)}, + {common_algs, Common} + | Config]; + _ -> + {skip, "No OpenSsh client found"} + end; + +init_per_group(erlc_opensshd, _) -> + {skip, "Group erlc_opensshd not implemented"}; + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, _Config) -> + ok. + + +init_per_testcase(_Func, Conf) -> + Conf. + +end_per_testcase(_Func, _Conf) -> + ok. + + +init_sftp_dirs(Config) -> + UserDir = ?config(priv_dir, Config), + SrcDir = filename:join(UserDir, "sftp_src"), + ok = file:make_dir(SrcDir), + SrcFile = "big_data", + DstDir = filename:join(UserDir, "sftp_dst"), + ok = file:make_dir(DstDir), + N = 100 * 1024*1024, + ok = file:write_file(filename:join(SrcDir,SrcFile), crypto:rand_bytes(N)), + [{sftp_src_dir,SrcDir}, {sftp_dst_dir,DstDir}, {src_file,SrcFile}, {sftp_size,N} + | Config]. + +%%%================================================================ +openssh_client_shell(Config) -> + lists:foreach( + fun(PrefAlgs=[{kex,[Kex]}]) when Kex == 'diffie-hellman-group-exchange-sha256' -> + lists:foreach( + fun(Grp) -> + openssh_client_shell(Config, + [{preferred_algorithms, PrefAlgs}, + {dh_gex_groups, [Grp]} + ]) + end, moduli()); + (PrefAlgs) -> + openssh_client_shell(Config, + [{preferred_algorithms, PrefAlgs}]) + end, variants(kex,Config) ++ variants(cipher,Config) + ). + + +openssh_client_shell(Config, Options) -> + SystemDir = ?config(data_dir, Config), + UserDir = ?config(priv_dir, Config), + KnownHosts = filename:join(UserDir, "known_hosts"), + + {ok, TracerPid} = erlang_trace(), + {ServerPid, _Host, Port} = + ssh_test_lib:daemon([{system_dir, SystemDir}, + {public_key_alg, ssh_dsa}, + {failfun, fun ssh_test_lib:failfun/2} | + Options]), + ct:sleep(500), + + Data = lists:duplicate(100000, $a), + Cmd = lists:concat(["ssh -p ",Port, + " -o UserKnownHostsFile=", KnownHosts, + " -o \"StrictHostKeyChecking no\"", + " localhost '\"",Data,"\"'."]), +%% ct:pal("Cmd ="++Cmd), + + Parent = self(), + SlavePid = spawn(fun() -> + Parent ! {self(),os:cmd(Cmd)} + end), + receive + {SlavePid, _ClientResponse} -> +%% ct:pal("ClientResponse = ~p",[_ClientResponse]), + {ok, List} = get_trace_list(TracerPid), + Times = find_times(List, [accept_to_hello, kex, kex_to_auth, auth, to_prompt]), + Algs = find_algs(List), + ct:pal("Algorithms = ~p~n~nTimes = ~p",[Algs,Times]), + lists:foreach( + fun({Tag,Value,Unit}) -> + EventData = + case Tag of + {A,B} when A==encrypt ; A==decrypt -> + [{value, Value}, + {suite, ?MODULE}, + {name, mk_name(["Cipher ",A," ",B," [",Unit,"]"])} + ]; + kex -> + KexAlgStr = fmt_alg(Algs#alg.kex, List), + [{value, Value}, + {suite, ?MODULE}, + {name, mk_name(["Erl server kex ",KexAlgStr," [",Unit,"]"])} + ]; + _ when is_atom(Tag) -> + [{value, Value}, + {suite, ?MODULE}, + {name, mk_name(["Erl server ",Tag," [",Unit,"]"])} + ] + end, + ct:pal("ct_event:notify ~p",[EventData]), + ct_event:notify(#event{name = benchmark_data, + data = EventData}) + end, Times), + ssh:stop_daemon(ServerPid), + ok + after 10000 -> + ssh:stop_daemon(ServerPid), + exit(SlavePid, kill), + {fail, timeout} + end. + + +%%%================================================================ +openssh_client_sftp(Config) -> + lists:foreach( + fun(PrefAlgs) -> + openssh_client_sftp(Config, [{preferred_algorithms,PrefAlgs}]) + end, variants(cipher,Config)). + + +openssh_client_sftp(Config, Options) -> + SystemDir = ?config(data_dir, Config), + UserDir = ?config(priv_dir, Config), + SftpSrcDir = ?config(sftp_src_dir, Config), + SrcFile = ?config(src_file, Config), + SrcSize = ?config(sftp_size, Config), + KnownHosts = filename:join(UserDir, "known_hosts"), + + {ok, TracerPid} = erlang_trace(), + {ServerPid, _Host, Port} = + ssh_test_lib:daemon([{system_dir, SystemDir}, + {public_key_alg, ssh_dsa}, + {subsystems,[ssh_sftpd:subsystem_spec([%{cwd, SftpSrcDir}, + {root, SftpSrcDir}])]}, + {failfun, fun ssh_test_lib:failfun/2} + | Options]), + ct:sleep(500), + Cmd = lists:concat(["sftp", + " -b -", + " -P ",Port, + " -o UserKnownHostsFile=", KnownHosts, + " -o \"StrictHostKeyChecking no\"", + " localhost:",SrcFile + ]), +%% ct:pal("Cmd = ~p",[Cmd]), + + Parent = self(), + SlavePid = spawn(fun() -> + Parent ! {self(),os:cmd(Cmd)} + end), + receive + {SlavePid, _ClientResponse} -> + ct:pal("ClientResponse = ~p",[_ClientResponse]), + {ok, List} = get_trace_list(TracerPid), +%%ct:pal("List=~p",[List]), + Times = find_times(List, [channel_open_close]), + Algs = find_algs(List), + ct:pal("Algorithms = ~p~n~nTimes = ~p",[Algs,Times]), + lists:foreach( + fun({{A,B},Value,Unit}) when A==encrypt ; A==decrypt -> + Data = [{value, Value}, + {suite, ?MODULE}, + {name, mk_name(["Sftp Cipher ",A," ",B," [",Unit,"]"])} + ], + ct:pal("sftp ct_event:notify ~p",[Data]), + ct_event:notify(#event{name = benchmark_data, + data = Data}); + ({channel_open_close,Value,Unit}) -> + Cipher = fmt_alg(Algs#alg.encrypt, List), + Data = [{value, round( (1024*Value) / SrcSize )}, + {suite, ?MODULE}, + {name, mk_name(["Sftp transfer ",Cipher," [",Unit," per kbyte]"])} + ], + ct:pal("sftp ct_event:notify ~p",[Data]), + ct_event:notify(#event{name = benchmark_data, + data = Data}); + (_) -> + skip + end, Times), + ssh:stop_daemon(ServerPid), + ok + after 10000 -> + ssh:stop_daemon(ServerPid), + exit(SlavePid, kill), + {fail, timeout} + end. + +%%%================================================================ +variants(Tag, Config) -> + TagType = + case proplists:get_value(Tag, ssh:default_algorithms()) of + [{_,_}|_] -> one_way; + [A|_] when is_atom(A) -> two_way + end, + [ [{Tag,tag_value(TagType,Alg)}] + || Alg <- proplists:get_value(Tag, ?config(common_algs,Config)) + ]. + +tag_value(two_way, Alg) -> [Alg]; +tag_value(one_way, Alg) -> [{client2server,[Alg]}, + {server2client,[Alg]}]. + +%%%---------------------------------------------------------------- +fmt_alg(Alg, List) when is_atom(Alg) -> + fmt_alg(atom_to_list(Alg), List); +fmt_alg(Alg = "diffie-hellman-group-exchange-sha" ++ _, List) -> + try + integer_to_list(find_gex_size_string(List)) + of + GexSize -> lists:concat([Alg," ",GexSize]) + catch + _:_ -> Alg + end; +fmt_alg(Alg, _List) -> + Alg. + +%%%---------------------------------------------------------------- +mk_name(Name) -> [char(C) || C <- lists:concat(Name)]. + +char($-) -> $_; +char(C) -> C. + +%%%---------------------------------------------------------------- +find_times(L, Xs) -> + [find_time(X,L) || X <- Xs] ++ + function_algs_times_sizes([{ssh_transport,encrypt,2}, + {ssh_transport,decrypt,2}, + {ssh_message,decode,1}, + {ssh_message,encode,1}], L). + +-record(call, { + mfa, + pid, + t_call, + t_return, + args, + result + }). + +%%%---------------- +-define(send(M), fun(C=#call{mfa = {ssh_message,encode,1}, + args = [M]}) -> + C#call.t_return + end). + +-define(recv(M), fun(C=#call{mfa = {ssh_message,decode,1}, + result = M}) -> + C#call.t_call + end). + +find_time(accept_to_hello, L) -> + [T0,T1] = find([fun(C=#call{mfa = {ssh_acceptor,handle_connection,5}}) -> + C#call.t_call + end, + fun(C=#call{mfa = {ssh_connection_handler,hello,_}, + args = [socket_control|_]}) -> + C#call.t_return + end + ], L, []), + {accept_to_hello, now2micro_sec(now_diff(T1,T0)), microsec}; +find_time(kex, L) -> + [T0,T1] = find([fun(C=#call{mfa = {ssh_connection_handler,hello,_}, + args = [socket_control|_]}) -> + C#call.t_call + end, + ?send(#ssh_msg_newkeys{}) + ], L, []), + {kex, now2micro_sec(now_diff(T1,T0)), microsec}; +find_time(kex_to_auth, L) -> + [T0,T1] = find([?send(#ssh_msg_newkeys{}), + ?recv(#ssh_msg_userauth_request{}) + ], L, []), + {kex_to_auth, now2micro_sec(now_diff(T1,T0)), microsec}; +find_time(auth, L) -> + [T0,T1] = find([?recv(#ssh_msg_userauth_request{}), + ?send(#ssh_msg_userauth_success{}) + ], L, []), + {auth, now2micro_sec(now_diff(T1,T0)), microsec}; +find_time(to_prompt, L) -> + [T0,T1] = find([fun(C=#call{mfa = {ssh_acceptor,handle_connection,5}}) -> + C#call.t_call + end, + ?recv(#ssh_msg_channel_request{request_type="env"}) + ], L, []), + {to_prompt, now2micro_sec(now_diff(T1,T0)), microsec}; +find_time(channel_open_close, L) -> + [T0,T1] = find([?recv(#ssh_msg_channel_request{request_type="subsystem"}), + ?send(#ssh_msg_channel_close{}) + ], L, []), + {channel_open_close, now2micro_sec(now_diff(T1,T0)), microsec}. + + + +find([F|Fs], [C|Cs], Acc) when is_function(F,1) -> + try + F(C) + of + T -> find(Fs, Cs, [T|Acc]) + catch + _:_ -> find([F|Fs], Cs, Acc) + end; +find([], _, Acc) -> + lists:reverse(Acc). + + +find_algs(L) -> + {value, #call{result={ok,Algs}}} = + lists:keysearch({ssh_transport,select_algorithm,3}, #call.mfa, L), + Algs. + +find_gex_size_string(L) -> + %% server + {value, #call{result={ok,{Size, _}}}} = + lists:keysearch({public_key,dh_gex_group,4}, #call.mfa, L), + Size. + +%%%---------------- +function_algs_times_sizes(EncDecs, L) -> + Raw = [begin + {Tag,Size} = function_ats_result(EncDec, C), + {Tag, Size, now2micro_sec(now_diff(T1,T0))} + end + || EncDec <- EncDecs, + C = #call{mfa = ED, + % args = Args, %%[S,Data], + t_call = T0, + t_return = T1} <- L, + ED == EncDec + ], + [{Alg, round(1024*Time/Size), "microsec per kbyte"} % Microseconds per 1k bytes. + || {Alg,Size,Time} <- lists:foldl(fun increment/2, [], Raw)]. + +function_ats_result({ssh_transport,encrypt,2}, #call{args=[S,Data]}) -> + {{encrypt,S#ssh.encrypt}, size(Data)}; +function_ats_result({ssh_transport,decrypt,2}, #call{args=[S,Data]}) -> + {{decrypt,S#ssh.decrypt}, size(Data)}; +function_ats_result({ssh_message,encode,1}, #call{result=Data}) -> + {encode, size(Data)}; +function_ats_result({ssh_message,decode,1}, #call{args=[Data]}) -> + {decode, size(Data)}. + + +increment({Alg,Sz,T}, [{Alg,SumSz,SumT}|Acc]) -> + [{Alg,SumSz+Sz,SumT+T} | Acc]; +increment(Spec, [X|Acc]) -> + [X | increment(Spec,Acc)]; % Not so many Alg, 2 or 3 +increment({Alg,Sz,T},[]) -> + [{Alg,Sz,T}]. + +%%%---------------------------------------------------------------- +%%% +%%% API for the traceing +%%% +get_trace_list(TracerPid) -> + TracerPid ! {get_trace_list,self()}, + receive + {trace_list,L} -> {ok, pair_events(lists:reverse(L))} + after 5000 -> {error,no_reply} + end. + +erlang_trace() -> + TracerPid = spawn(fun trace_loop/0), + 0 = erlang:trace(new, true, [call,timestamp,{tracer,TracerPid}]), + [init_trace(MFA, tp(MFA)) + || MFA <- [{ssh_acceptor,handle_connection,5}, + {ssh_connection_handler,hello,2}, + {ssh_message,encode,1}, + {ssh_message,decode,1}, + {ssh_transport,select_algorithm,3}, + {ssh_transport,encrypt,2}, + {ssh_transport,decrypt,2}, + {ssh_message,encode,1}, + {ssh_message,decode,1}, + {public_key,dh_gex_group,4} % To find dh_gex group size + ]], + {ok, TracerPid}. + +tp({_M,_F,Arity}) -> + [{lists:duplicate(Arity,'_'), [], [{return_trace}]}]. + +%%%---------------------------------------------------------------- +init_trace(MFA = {Module,_,_}, TP) -> + case code:is_loaded(Module) of + false -> code:load_file(Module); + _ -> ok + end, + erlang:trace_pattern(MFA, TP, [local]). + + +trace_loop() -> + trace_loop([]). + +trace_loop(L) -> + receive + {get_trace_list, From} -> + From ! {trace_list, L}, + trace_loop(L); + Ev -> + trace_loop([Ev|L]) + end. + +pair_events(L) -> + pair_events(L, []). + +pair_events([{trace_ts,Pid,call,{M,F,Args},TS0} | L], Acc) -> + Arity = length(Args), + {ReturnValue,TS1} = find_return(Pid, {M,F,Arity}, L), + pair_events(L, [#call{mfa = {M,F,Arity}, + pid = Pid, + t_call = TS0, + t_return = TS1, + args = Args, + result = ReturnValue} | Acc]); +pair_events([_|L], Acc) -> + pair_events(L, Acc); +pair_events([], Acc) -> + lists:reverse(Acc). + + +find_return(Pid, MFA, + [{trace_ts, Pid, return_from, MFA, ReturnValue, TS}|_]) -> + {ReturnValue, TS}; +find_return(Pid, MFA, [_|L]) -> + find_return(Pid, MFA, L); +find_return(_, _, []) -> + {undefined, undefined}. + +%%%---------------------------------------------------------------- +report_client_algorithms() -> + try + ssh_test_lib:extract_algos( ssh_test_lib:default_algorithms(sshc) ) + of + ClientAlgs -> + ct:pal("The client supports:~n~p",[ClientAlgs]) + catch + Cls:Err -> + ct:pal("Testing client about algorithms failed:~n~p ~p",[Cls,Err]) + end. + +%%%---------------------------------------------------------------- + + +now2sec({A,B,C}) -> A*1000000 + B + C/1000000. + +now2micro_sec({A,B,C}) -> (A*1000000 + B)*1000000 + C. + +now_diff({A1,B1,C1}, {A0,B0,C0}) -> {A1-A0, B1-B0, C1-C0}. + +%%%================================================================ +moduli() -> + [{1023, 5, 16#CF973CD39DC7D62F2C45AAC5180491104C76E0FE5D80A10E6C06AE442F1F373167B0FCBC931F3C157B10A5557008FDE20D68051E6A4DB11CEE0B0749F76D7134B937A59DA998C42BC234A5C1A3CFCD70E624D253D7694076F7B1FD7B8D3427849C9377B3555796ACA58C69DFF542EEEC9859D3ADCE5CC88DF6F7817C9D182EB7}, + {2047, 5, 16#F7693FC11FDDEAA493D3BA36F1FFF9264AA9952209203192A88A697BE9D0E306E306A27430BD87AB9EE9DB4BC78C41950C2EB0E5E4C686E8B1BA6D6A2B1FE91EF40C5EA32C51018323E1D305FE637F35ACABDBFC40AD683F779570A76869EB90015A342B2D1F7C81602688081FCAAA8D623090258D9C5C729C8CDDC0C12CA2D561DD987DB79B6AD7A2A509EBC383BF223FD95BC5A2FCC26FB3F3A0DD3FDC1228E338D3290235A596F9465F7BF490974847E616229A9E60B8F4AA161C52F655843CCCAE8821B40C426B535DE087964778652BBD4EC601C0456AE7128B593FCC64402C891227AE6EE88CC839416FBF462B4852999C646BE0BED7D8CF2BE5E381EF}, + {4095, 2, 16#C8842271626E53546E0C712FA265713F2EE073C20A0723C96B6B182B1EAACC96233D4A199BD0E85F264078A513AD2454F284B8DF543D85019D1E70F2FF54BA43EFBC64AF465C170C3E376F5EC328F98E33E1ED8BED84FA097ABE584152B0E9827ED5CC2B1D4F5ECF2DC46F45C59816D02698EA26F319311E2B6973E83C37021CC8B416AEF653896A1764EE0CEE718A45E8B47CB960BD5907D0E843E8A8E7D4698363C3C3FB3ADC512368B72CAF16510C69052EA2AF51BE00BC8CA04DF1F00A00CC2CA4D74254A1E8738460FD244DDB446CB36554B0A24EEF3710E44DBCF39881E7D3F9AE223388084E7A49A3CB12612AE36416C0EB5628DF1477FEE4A5CF77CDC09AA0E2C989C0B7D1310AFA44B81DA79A65226C7EA510057991EABF9388DC5EA9F52FEA5D3B0872843F50878740794E523E9DC60E0EA1FC8746A7B2AA31FCA89AAA2FA907BED116C69D98F912DD5089BECF28577064225DE96FC214ED1794E7CCE8024F94036D915A123A464C951DA96A5ED7F286F205BEE71BDE2D133FD1891B31178FF25D31611A5B7839F0E68EAF0F8901A571E6917C580F31842A9F19C47E0638483B7947DDCD7864660AC2F8B2C430F1E7FC0F22FA51F96F0499332C5AD3FF9DC7F4332DD5BCCA820CC779B90C0F4C5F0CA52E96FAA187361753FBADC5C80D0492CD80A3EEA5D578772DA9FC1C0E10A0203098AF36D0ED2156BA7321EB}, + {6143, 5, 16#FD9E6B52785CD7BE64D396A599DA4B97CD0BB49183F932A97694D80CA553354DBC26E77B8A0EC002257AADDF6AD27819CE64A06416E4A80B6EA92F28EA8D5B96C774109EEE5816B4B18F84368D1B41864C11AA73D6881675D779B174F6B4E344303F3EFD11BD7DE468467242372FD00908F296F5A2B20E2684F9122D08A46D647B05E298F0BCDAB60468349CCA6DA1B9FEBBC69D256FB9A3F1980F68466364FCEF1C98C1405191A6737A3627BA7F7313A8A18FC0B8521BF3430B1C6805CB44BCEB39904DD30130D24B225B598ED83C5FD757B80189FD9D5C2F9596687C40BAB1C6ED6244944629849D074A4C33FB15DDB3F9760FC59C44BEBB0EC032177147F61789769DAAAE2123CE488F7ECF19BDA051925BA9ED11EAA72DF70C9ECC8F714B4C35728E6679E66A1B56CCAE0FBBD3F9EBF950D4D623ED78E77CC3AD604E91F304EA78CE876F036214BD6F1977BD04C9ADD707D7A3BCCE87AD5D5A11C95E7025B0EA9C649DCB37942A3970A4FB04C284E4DDB4DC90163353B98B1C254FFD28443353F17A87C02E0BDB9F05424CC44C86309F1D73706F039CDAAC3EDC1A64F38FB42707D351DB5360C2680ADC1CC8D1C4AD312ACC904382C26BE33DA0E61429A5940820356ED28586BEB629ED1521D12D25B4DA01926295F3DA504DC9F431B719AC63277BE675E6F6DD4F7499CA11A23744577D653941963E8DAB610F7F226DB52CE5C683F72AEED2B6CE35ED07C29410397A6F7F606477CCC0EDE18CD0D96A7863BC4606193A8799B5AC1EEE6AC5EE36AC3077EC8DAB30EE94434B45B78BC13D96F74D6C4056EAA528CD3C68D308344808819B12F2BFB95A5C1A7DEEE188BF139216DDB7D757D7A50D3C46CE18881D776D617DCFFAA62276045373AA4D9446D7570338F99C0CA8A08851B4F9D388B4C275D3F9B7BA25F235D4329F63F7457C2EB5C68CE2A96D19766F0ED8E19F66DF3C5E29A38795B2F92291BB6EAB6F70A7E89DC9691F28486E9CF87FF11D5DF2E6B030A30B5D476AD59A34EE7262712ED96CEF4A5CAC3F08B3563D44683F746DA094C9CDB34427AF8D8CC2AE1B23C3BEB637}, + {8191, 2, 16#DC61EF13E4F3FC10CC946EEABC33F83EFCB35E0F47E4EC25C1CCBB2C7B502B2EFB0691AA231C8476DD51BA73204E6EA10B1A970FE2CF14AF01E72E1AEA87519A91D00D1499189F94A6CDA9E29C05F11F17FE74A4919A710A2787E180744465DF81C62AA65662FDA46FA6175E8A31E5B29E66DED6701C8FC4217E91D733FE94380F046680967D4CEA7BAC8F3916CDF96AA2C474FAD9650F48403FD0B5B756D34667D36A07767FA33027AE55484D0F701C3CA16632F413A14E4B8645AFAF15B78978C19A7661EDC569BEC72394B1204B166A48FCD5F56BE29840C7794CA6D3440356F15858CDCA9B429C7EA92E17242893FDC8C9C63841A382C32F20CFAB121B4BCAFD7BF9EF07FBF7CDFFECA0CEF3A49C3E2B24FA836F3318435255655E1B281071F62D5E4CD63361299B7828F72936E3FEA9E8044562A6F6ADD5321187C3101E4669C6271598FE1A866C93FE2870A4CEB9254BA32A4719E439317EA42200A335B5CFFA7946A7D0F1BD1A69AA11288B73C71C80B77FE3707CB077DDDEA5CA36A449FAB230C9625A0B12F8275D3FF82F5DA380E7A3F11B6F155FE7E91AC960BD95D9B13F7423AB9B15CC3C4DC34EF296033F009468EA16A721AD659F56C18516025050749ABF05E6D3EBD9778142A530979291F46DAA399A86B7BCDF09CC3E6EEF101419762A306DB45AEFC96C64E83F28338D55905F6A387E0F515E580C3A9B35330E21C32198CDEE3AFB355967A098F635FCA7C49CB4E1E82464B2B390EF1F259E40B9A06235C0273F76284FE6BD534EF3AF7CB01A4A5252B8B94CADC2850B2E56D53F9A31D7C029DF967D0A30C05BC64E119BED6076818FABC8CDD93F3255693E14EFC1A740A5D63A5E847FFE87BAB1DDE0506E1762EA61EFA9F9756151ECCCADD91B98A961A901A2D8B01ABDDD29EC804E8C8D28214BBA26048F924CA66316696E51A49D02FF034D20E44914B1115339CAD3819E0CB1640F0084886FEDDE5E28C29DC48ED30A8C3D789734338F5A9DF42584326E536FD1CF30BC85B8DCBD6120D127C98FE4B3614074F13C2CA4854E6D794156C185C40EB3DA7619CE96ADAF0941BD5499848B034C2B11DFECC0BDFA81C594241F759EF53FC7CDE7F2DE4F23CF81A5A0B7D62E31DABB9198D40307F7824DD130B7D1B80E9B6D322FEEDB5ACE34944F0BFB7D016762A9B2E173BFDD69303766AFBAB45FAB75D05430B4A3515858C4B7F04E23414E4AD03842CB0A20D8FF4B59B7C852BA9A5BE982A8ADA5CB70C36CE2A4D2C31A7015C9F3275E43D192C1B2924424088907A057DA7F2D32A2149922AB2E33F2147D637A3508911CB3FEA5E1AAB4525BACF27B6DD7A3E0AFA978FC3A39DE8882FB22688C3CCC92B6E69ACB0BBF575AB3368E51A2F6A20C414C6F146727CC0045F29061E695D29F7C030CE6929EB3AD11A5CBD0CDEE37347869A3}]. diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/id_dsa b/lib/ssh/test/ssh_benchmark_SUITE_data/id_dsa new file mode 100644 index 0000000000..d306f8b26e --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/id_dsa @@ -0,0 +1,13 @@ +-----BEGIN DSA PRIVATE KEY----- +MIIBvAIBAAKBgQDfi2flSTZZofwT4yQT0NikX/LGNT7UPeB/XEWe/xovEYCElfaQ +APFixXvEgXwoojmZ5kiQRKzLM39wBP0jPERLbnZXfOOD0PDnw0haMh7dD7XKVMod +/EigVgHf/qBdM2M8yz1s/rRF7n1UpLSypziKjkzCm7JoSQ2zbWIPdmBIXwIVAMgP +kpr7Sq3O7sHdb8D601DRjoExAoGAMOQxDfB2Fd8ouz6G96f/UOzRMI/Kdv8kYYKW +JIGY+pRYrLPyYzUeJznwZreOJgrczAX+luHnKFWJ2Dnk5CyeXk67Wsr7pJ/4MBMD +OKeIS0S8qoSBN8+Krp79fgA+yS3IfqbkJLtLu4EBaCX4mKQIX4++k44d4U5lc8pt ++9hlEI8CgYEAznKxx9kyC6bVo7LUYKaGhofRFt0SYFc5PVmT2VUGRs1R6+6DPD+e +uEO6IhFct7JFSRbP9p0JD4Uk+3zlZF+XX6b2PsZkeV8f/02xlNGUSmEzCSiNg1AX +Cy/WusYhul0MncWCHMcOZB5rIvU/aP5EJJtn3xrRaz6u0SThF6AnT34CFQC63czE +ZU8w8Q+H7z0j+a+70x2iAw== +-----END DSA PRIVATE KEY----- + diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa256 b/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa256 new file mode 100644 index 0000000000..4b1eb12eaa --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa256 @@ -0,0 +1,5 @@ +-----BEGIN EC PRIVATE KEY----- +MHcCAQEEIJfCaBKIIKhjbJl5F8BedqlXOQYDX5ba9Skypllmx/w+oAoGCCqGSM49 +AwEHoUQDQgAE49RbK2xQ/19ji3uDPM7uT4692LbwWF1TiaA9vUuebMGazoW/98br +N9xZu0L1AWwtEjs3kmJDTB7eJEGXnjUAcQ== +-----END EC PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa256.pub b/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa256.pub new file mode 100644 index 0000000000..a0147e60fa --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa256.pub @@ -0,0 +1 @@ +ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBOPUWytsUP9fY4t7gzzO7k+Ovdi28FhdU4mgPb1LnmzBms6Fv/fG6zfcWbtC9QFsLRI7N5JiQ0we3iRBl541AHE= uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa384 b/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa384 new file mode 100644 index 0000000000..4e8aa40959 --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa384 @@ -0,0 +1,6 @@ +-----BEGIN EC PRIVATE KEY----- +MIGkAgEBBDCYXb6OSAZyXRfLXOtMo43za197Hdc/T0YKjgQQjwDt6rlRwqTh7v7S +PV2kXwNGdWigBwYFK4EEACKhZANiAARN2khlJUOOIiwsWHEALwDieeZR96qL4pUd +ci7aeGaczdUK5jOA9D9zmBZtSYTfO8Cr7ekVghDlcWAIJ/BXcswgQwSEQ6wyfaTF +8FYfyr4l3u9IirsnyaFzeIgeoNis8Gw= +-----END EC PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa384.pub b/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa384.pub new file mode 100644 index 0000000000..41e722e545 --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa384.pub @@ -0,0 +1 @@ +ecdsa-sha2-nistp384 AAAAE2VjZHNhLXNoYTItbmlzdHAzODQAAAAIbmlzdHAzODQAAABhBE3aSGUlQ44iLCxYcQAvAOJ55lH3qovilR1yLtp4ZpzN1QrmM4D0P3OYFm1JhN87wKvt6RWCEOVxYAgn8FdyzCBDBIRDrDJ9pMXwVh/KviXe70iKuyfJoXN4iB6g2KzwbA== uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa521 b/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa521 new file mode 100644 index 0000000000..7196f46e97 --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa521 @@ -0,0 +1,7 @@ +-----BEGIN EC PRIVATE KEY----- +MIHbAgEBBEFMadoz4ckEcClfqXa2tiUuYkJdDfwq+/iFQcpt8ESuEd26IY/vm47Q +9UzbPkO4ou8xkNsQ3WvCRQBBWtn5O2kUU6AHBgUrgQQAI6GBiQOBhgAEAde5BRu5 +01/jS0jRk212xsb2DxPrxNpgp6IMCV8TA4Eps+8bSqHB091nLiBcP422HXYfuCd7 +XDjSs8ihcmhp0hCRASLqZR9EzW9W/SOt876May1Huj5X+WSO6RLe7vPn9vmf7kHf +pip6m7M7qp2qGgQ3q2vRwS2K/O6156ohiOlmuuFs +-----END EC PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa521.pub b/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa521.pub new file mode 100644 index 0000000000..8f059120bc --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa521.pub @@ -0,0 +1 @@ +ecdsa-sha2-nistp521 AAAAE2VjZHNhLXNoYTItbmlzdHA1MjEAAAAIbmlzdHA1MjEAAACFBAHXuQUbudNf40tI0ZNtdsbG9g8T68TaYKeiDAlfEwOBKbPvG0qhwdPdZy4gXD+Nth12H7gne1w40rPIoXJoadIQkQEi6mUfRM1vVv0jrfO+jGstR7o+V/lkjukS3u7z5/b5n+5B36YqepuzO6qdqhoEN6tr0cEtivzuteeqIYjpZrrhbA== uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/id_rsa b/lib/ssh/test/ssh_benchmark_SUITE_data/id_rsa new file mode 100644 index 0000000000..9d7e0dd5fb --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/id_rsa @@ -0,0 +1,15 @@ +-----BEGIN RSA PRIVATE KEY----- +MIICXAIBAAKBgQD1OET+3O/Bvj/dtjxDTXmj1oiJt4sIph5kGy0RfjoPrZfaS+CU +DhakCmS6t2ivxWFgtpKWaoGMZMJqWj6F6ZsumyFl3FPBtujwY/35cgifrI9Ns4Tl +zR1uuengNBmV+WRQ5cd9F2qS6Z8aDQihzt0r8JUqLcK+VQbrmNzboCCQQwIDAQAB +AoGAPQEyqPTt8JUT7mRXuaacjFXiweAXhp9NEDpyi9eLOjtFe9lElZCrsUOkq47V +TGUeRKEm9qSodfTbKPoqc8YaBJGJPhUaTAcha+7QcDdfHBvIsgxvU7ePVnlpXRp3 +CCUEMPhlnx6xBoTYP+fRU0e3+xJIPVyVCqX1jAdUMkzfRoECQQD6ux7B1QJAIWyK +SGkbDUbBilNmzCFNgIpOP6PA+bwfi5d16diTpra5AX09keQABAo/KaP1PdV8Vg0p +z4P3A7G3AkEA+l+AKG6m0kQTTBMJDqOdVPYwe+5GxunMaqmhokpEbuGsrZBl5Dvd +WpcBjR7jmenrhKZRIuA+Fz5HPo/UQJPl1QJBAKxstDkeED8j/S2XoFhPKAJ+6t39 +sUVICVTIZQeXdmzHJXCcUSkw8+WEhakqw/3SyW0oaK2FSWQJFWJUZ+8eJj8CQEh3 +xeduB5kKnS9CvzdeghZqX6QvVosSdtlUmfUYW/BgH5PpHKTP8wTaeld3XldZTpMJ +dKiMkUw2+XYROVUrubUCQD+Na1LhULlpn4ISEtIEfqpdlUhxDgO15Wg8USmsng+x +ICliVOSQtwaZjm8kwaFt0W7XnpnDxbRs37vIEbIMWak= +-----END RSA PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_dsa_key b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_dsa_key new file mode 100644 index 0000000000..51ab6fbd88 --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_dsa_key @@ -0,0 +1,13 @@ +-----BEGIN DSA PRIVATE KEY----- +MIIBuwIBAAKBgQCClaHzE2ul0gKSUxah5W0W8UiJLy4hXngKEqpaUq9SSdVdY2LK +wVfKH1gt5iuaf1FfzOhsIC9G/GLnjYttXZc92cv/Gfe3gR+s0ni2++MX+T++mE/Q +diltXv/Hp27PybS67SmiFW7I+RWnT2OKlMPtw2oUuKeztCe5UWjaj/y5FQIVAPLA +l9RpiU30Z87NRAHY3NTRaqtrAoGANMRxw8UfdtNVR0CrQj3AgPaXOGE4d+G4Gp4X +skvnCHycSVAjtYxebUkzUzt5Q6f/IabuLUdge3gXrc8BetvrcKbp+XZgM0/Vj2CF +Ymmy3in6kzGZq7Fw1sZaku6AOU8vLa5woBT2vAcHLLT1bLAzj7viL048T6MfjrOP +ef8nHvACgYBhDWFQJ1mf99sg92LalVq1dHLmVXb3PTJDfCO/Gz5NFmj9EZbAtdah +/XcF3DeRF+eEoz48wQF/ExVxSMIhLdL+o+ElpVhlM7Yii+T7dPhkQfEul6zZXu+U +ykSTXYUbtsfTNRFQGBW2/GfnEc0mnIxfn9v10NEWMzlq5z9wT9P0CgIVAN4wtL5W +Lv62jKcdskxNyz2NQoBx +-----END DSA PRIVATE KEY----- + diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_dsa_key.pub b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_dsa_key.pub new file mode 100644 index 0000000000..4dbb1305b0 --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_dsa_key.pub @@ -0,0 +1,11 @@ +---- BEGIN SSH2 PUBLIC KEY ---- +AAAAB3NzaC1kc3MAAACBAIKVofMTa6XSApJTFqHlbRbxSIkvLiFeeAoSqlpSr1JJ1V1j +YsrBV8ofWC3mK5p/UV/M6GwgL0b8YueNi21dlz3Zy/8Z97eBH6zSeLb74xf5P76YT9B2 +KW1e/8enbs/JtLrtKaIVbsj5FadPY4qUw+3DahS4p7O0J7lRaNqP/LkVAAAAFQDywJfU +aYlN9GfOzUQB2NzU0WqrawAAAIA0xHHDxR9201VHQKtCPcCA9pc4YTh34bganheyS+cI +fJxJUCO1jF5tSTNTO3lDp/8hpu4tR2B7eBetzwF62+twpun5dmAzT9WPYIViabLeKfqT +MZmrsXDWxlqS7oA5Ty8trnCgFPa8BwcstPVssDOPu+IvTjxPox+Os495/yce8AAAAIBh +DWFQJ1mf99sg92LalVq1dHLmVXb3PTJDfCO/Gz5NFmj9EZbAtdah/XcF3DeRF+eEoz48 +wQF/ExVxSMIhLdL+o+ElpVhlM7Yii+T7dPhkQfEul6zZXu+UykSTXYUbtsfTNRFQGBW2 +/GfnEc0mnIxfn9v10NEWMzlq5z9wT9P0Cg== +---- END SSH2 PUBLIC KEY ---- diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key256 b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key256 new file mode 100644 index 0000000000..2979ea88ed --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key256 @@ -0,0 +1,5 @@ +-----BEGIN EC PRIVATE KEY----- +MHcCAQEEIMe4MDoit0t8RzSVPwkCBemQ9fhXL+xnTSAWISw8HNCioAoGCCqGSM49 +AwEHoUQDQgAEo2q7U3P6r0W5WGOLtM78UQtofM9UalEhiZeDdiyylsR/RR17Op0s +VPGSADLmzzgcucLEKy17j2S+oz42VUJy5A== +-----END EC PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key256.pub b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key256.pub new file mode 100644 index 0000000000..85dc419345 --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key256.pub @@ -0,0 +1 @@ +ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBKNqu1Nz+q9FuVhji7TO/FELaHzPVGpRIYmXg3YsspbEf0UdezqdLFTxkgAy5s84HLnCxCste49kvqM+NlVCcuQ= uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key384 b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key384 new file mode 100644 index 0000000000..fb1a862ded --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key384 @@ -0,0 +1,6 @@ +-----BEGIN EC PRIVATE KEY----- +MIGkAgEBBDArxbDfh3p1okrD9wQw6jJ4d4DdlBPD5GqXE8bIeRJiK41Sh40LgvPw +mkqEDSXK++CgBwYFK4EEACKhZANiAAScl43Ih2lWTDKrSox5ve5uiTXil4smsup3 +CfS1XPjKxgBAmlfBim8izbdrT0BFdQzz2joduNMtpt61wO4rGs6jm0UP7Kim9PC7 +Hneb/99fIYopdMH5NMnk60zGO1uZ2vc= +-----END EC PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key384.pub b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key384.pub new file mode 100644 index 0000000000..428d5fb7d7 --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key384.pub @@ -0,0 +1 @@ +ecdsa-sha2-nistp384 AAAAE2VjZHNhLXNoYTItbmlzdHAzODQAAAAIbmlzdHAzODQAAABhBJyXjciHaVZMMqtKjHm97m6JNeKXiyay6ncJ9LVc+MrGAECaV8GKbyLNt2tPQEV1DPPaOh240y2m3rXA7isazqObRQ/sqKb08Lsed5v/318hiil0wfk0yeTrTMY7W5na9w== uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key521 b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key521 new file mode 100644 index 0000000000..3e51ec2ecd --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key521 @@ -0,0 +1,7 @@ +-----BEGIN EC PRIVATE KEY----- +MIHcAgEBBEIB8O1BFkl2HQjQLRLonEZ97da/h39DMa9/0/hvPZWAI8gUPEQcHxRx +U7b09p3Zh+EBbMFq8+1ae9ds+ZTxE4WFSvKgBwYFK4EEACOhgYkDgYYABAAlWVjq +Bzg7Wt4gE6UNb1lRE2cnlmH2L/A5uo6qZRx5lPnSKOxEhxSb/Oay1+9d6KRdrh6/ +vlhd9SHDBhLcAPDvWgBnJIEj92Q3pXX4JtoitL0yl+SvvU+vUh966mzHShHzj8p5 +ccOgPkPNoA70yrpGzkIhPezpZOQdCaOXj/jFqNCTDg== +-----END EC PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key521.pub b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key521.pub new file mode 100644 index 0000000000..017a29f4da --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key521.pub @@ -0,0 +1 @@ +ecdsa-sha2-nistp521 AAAAE2VjZHNhLXNoYTItbmlzdHA1MjEAAAAIbmlzdHA1MjEAAACFBAAlWVjqBzg7Wt4gE6UNb1lRE2cnlmH2L/A5uo6qZRx5lPnSKOxEhxSb/Oay1+9d6KRdrh6/vlhd9SHDBhLcAPDvWgBnJIEj92Q3pXX4JtoitL0yl+SvvU+vUh966mzHShHzj8p5ccOgPkPNoA70yrpGzkIhPezpZOQdCaOXj/jFqNCTDg== uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_rsa_key b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_rsa_key new file mode 100644 index 0000000000..79968bdd7d --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_rsa_key @@ -0,0 +1,16 @@ +-----BEGIN RSA PRIVATE KEY----- +MIICXQIBAAKBgQDCZX+4FBDwZIh9y/Uxee1VJnEXlowpz2yDKwj8semM4q843337 +zbNfxHmladB1lpz2NqyxI175xMIJuDxogyZdsOxGnFAzAnthR4dqL/RWRWzjaxSB +6IAO9SPYVVlrpZ+1hsjLW79fwXK/yc8VdhRuWTeQiRgYY2ek8+OKbOqz4QIDAQAB +AoGANmvJzJO5hkLuvyDZHKfAnGTtpifcR1wtSa9DjdKUyn8vhKF0mIimnbnYQEmW +NUUb3gXCZLi9PvkpRSVRrASDOZwcjoU/Kvww163vBUVb2cOZfFhyn6o2Sk88Tt++ +udH3hdjpf9i7jTtUkUe+QYPsia+wgvvrmn4QrahLAH86+kECQQDx5gFeXTME3cnW +WMpFz3PPumduzjqgqMMWEccX4FtQkMX/gyGa5UC7OHFyh0N/gSWvPbRHa8A6YgIt +n8DO+fh5AkEAzbqX4DOn8NY6xJIi42q7l/2jIA0RkB6P7YugW5NblhqBZ0XDnpA5 +sMt+rz+K07u9XZtxgh1xi7mNfwY6lEAMqQJBAJBEauCKmRj35Z6OyeQku59SPsnY ++SJEREVvSNw2lH9SOKQQ4wPsYlTGbvKtNVZgAcen91L5MmYfeckYE/fdIZECQQCt +64zxsTnM1I8iFxj/gP/OYlJBikrKt8udWmjaghzvLMEw+T2DExJyb9ZNeT53+UMB +m6O+B/4xzU/djvp+0hbhAkAemIt+rA5kTmYlFndhpvzkSSM8a2EXsO4XIPgGWCTT +tQKS/tTly0ADMjN/TVy11+9d6zcqadNVuHXHGtR4W0GR +-----END RSA PRIVATE KEY----- + diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_rsa_key.pub b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_rsa_key.pub new file mode 100644 index 0000000000..75d2025c71 --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_rsa_key.pub @@ -0,0 +1,5 @@ +---- BEGIN SSH2 PUBLIC KEY ---- +AAAAB3NzaC1yc2EAAAADAQABAAAAgQDCZX+4FBDwZIh9y/Uxee1VJnEXlowpz2yDKwj8 +semM4q843337zbNfxHmladB1lpz2NqyxI175xMIJuDxogyZdsOxGnFAzAnthR4dqL/RW +RWzjaxSB6IAO9SPYVVlrpZ+1hsjLW79fwXK/yc8VdhRuWTeQiRgYY2ek8+OKbOqz4Q== +---- END SSH2 PUBLIC KEY ---- diff --git a/lib/ssh/test/ssh_connection_SUITE.erl b/lib/ssh/test/ssh_connection_SUITE.erl index 1b93cc9c32..67d870bea4 100644 --- a/lib/ssh/test/ssh_connection_SUITE.erl +++ b/lib/ssh/test/ssh_connection_SUITE.erl @@ -36,6 +36,9 @@ %% suite() -> %% [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{timetrap,{minutes,5}}]. + all() -> [ {group, openssh}, @@ -67,16 +70,10 @@ ptty() -> %%-------------------------------------------------------------------- init_per_suite(Config) -> - catch crypto:stop(), - case catch crypto:start() of - ok -> - Config; - _Else -> - {skip, "Crypto could not be started!"} - end. + Config. -end_per_suite(_Config) -> - crypto:stop(). +end_per_suite(Config) -> + Config. %%-------------------------------------------------------------------- init_per_group(openssh, Config) -> diff --git a/lib/ssh/test/ssh_options_SUITE.erl b/lib/ssh/test/ssh_options_SUITE.erl index 6a201d401f..e0ef3a4b05 100644 --- a/lib/ssh/test/ssh_options_SUITE.erl +++ b/lib/ssh/test/ssh_options_SUITE.erl @@ -79,7 +79,8 @@ %%-------------------------------------------------------------------- suite() -> - [{ct_hooks,[ts_install_cth]}]. + [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,5}}]. all() -> [connectfun_disconnectfun_server, @@ -125,16 +126,11 @@ groups() -> %%-------------------------------------------------------------------- init_per_suite(Config) -> - catch crypto:stop(), - case catch crypto:start() of - ok -> - Config; - _Else -> - {skip, "Crypto could not be started!"} - end. + Config. + end_per_suite(_Config) -> - ssh:stop(), - crypto:stop(). + ssh:stop(). + %%-------------------------------------------------------------------- init_per_group(hardening_tests, Config) -> DataDir = ?config(data_dir, Config), diff --git a/lib/ssh/test/ssh_protocol_SUITE.erl b/lib/ssh/test/ssh_protocol_SUITE.erl index 5af60adfae..cabdd35615 100644 --- a/lib/ssh/test/ssh_protocol_SUITE.erl +++ b/lib/ssh/test/ssh_protocol_SUITE.erl @@ -42,12 +42,14 @@ %%-------------------------------------------------------------------- suite() -> - [{ct_hooks,[ts_install_cth]}]. + [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,5}}]. all() -> [{group,tool_tests}, {group,kex}, {group,service_requests}, + {group,authentication}, {group,packet_size_error}, {group,field_size_error} ]. @@ -78,7 +80,9 @@ groups() -> bad_very_long_service_name, empty_service_name, bad_service_name_then_correct - ]} + ]}, + {authentication, [], [client_handles_keyboard_interactive_0_pwds + ]} ]. @@ -277,12 +281,7 @@ no_common_alg_server_disconnects(Config) -> {send, hello}, {match, #ssh_msg_kexinit{_='_'}, receive_msg}, {send, ssh_msg_kexinit}, % with server unsupported 'ssh-dss' ! - {match, - {'or',[#ssh_msg_disconnect{code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, _='_'}, - tcp_closed, - {tcp_error,econnaborted} - ]}, - receive_msg} + {match, disconnect(), receive_msg} ] ). @@ -309,7 +308,7 @@ no_common_alg_client_disconnects(Config) -> {send, hello}, {match, #ssh_msg_kexinit{_='_'}, receive_msg}, {send, #ssh_msg_kexinit{ % with unsupported "SOME-UNSUPPORTED" - cookie = 247381486335508958743193106082599558706, + cookie = <<80,158,95,51,174,35,73,130,246,141,200,49,180,190,82,234>>, kex_algorithms = ["diffie-hellman-group1-sha1"], server_host_key_algorithms = ["SOME-UNSUPPORTED"], % SIC! encryption_algorithms_client_to_server = ["aes128-ctr"], @@ -323,10 +322,7 @@ no_common_alg_client_disconnects(Config) -> first_kex_packet_follows = false, reserved = 0 }}, - {match, - {'or',[#ssh_msg_disconnect{code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, _='_'}, - tcp_closed]}, - receive_msg} + {match, disconnect(?SSH_DISCONNECT_KEY_EXCHANGE_FAILED), receive_msg} ], InitialState) } @@ -437,10 +433,7 @@ bad_service_name_then_correct(Config) -> [{set_options, [print_ops, print_seqnums, print_messages]}, {send, #ssh_msg_service_request{name = "kdjglkfdjgkldfjglkdfjglkfdjglkj"}}, {send, #ssh_msg_service_request{name = "ssh-connection"}}, - {match, {'or',[#ssh_msg_disconnect{_='_'}, - tcp_closed - ]}, - receive_msg} + {match, disconnect(), receive_msg} ], InitialState). @@ -450,10 +443,7 @@ bad_service_name(Config, Name) -> ssh_trpt_test_lib:exec( [{set_options, [print_ops, print_seqnums, print_messages]}, {send, #ssh_msg_service_request{name = Name}}, - {match, {'or',[#ssh_msg_disconnect{_='_'}, - tcp_closed - ]}, - receive_msg} + {match, disconnect(), receive_msg} ], InitialState). %%%-------------------------------------------------------------------- @@ -476,11 +466,7 @@ bad_packet_length(Config, LengthExcess) -> PacketFun}}, %% Prohibit remote decoder starvation: {send, #ssh_msg_service_request{name="ssh-userauth"}}, - {match, {'or',[#ssh_msg_disconnect{_='_'}, - tcp_closed, - {tcp_error,econnaborted} - ]}, - receive_msg} + {match, disconnect(), receive_msg} ], InitialState). %%%-------------------------------------------------------------------- @@ -509,36 +495,96 @@ bad_service_name_length(Config, LengthExcess) -> PacketFun} }, %% Prohibit remote decoder starvation: {send, #ssh_msg_service_request{name="ssh-userauth"}}, - {match, {'or',[#ssh_msg_disconnect{_='_'}, - tcp_closed, - {tcp_error,econnaborted} - ]}, - receive_msg} + {match, disconnect(), receive_msg} ], InitialState). +%%%-------------------------------------------------------------------- +%%% This is due to a fault report (OTP-13255) with OpenSSH-6.6.1 +client_handles_keyboard_interactive_0_pwds(Config) -> + {User,_Pwd} = server_user_password(Config), + + %% Create a listening socket as server socket: + {ok,InitialState} = ssh_trpt_test_lib:exec(listen), + HostPort = ssh_trpt_test_lib:server_host_port(InitialState), + + %% Start a process handling one connection on the server side: + spawn_link( + fun() -> + {ok,_} = + ssh_trpt_test_lib:exec( + [{set_options, [print_ops, print_messages]}, + {accept, [{system_dir, system_dir(Config)}, + {user_dir, user_dir(Config)}]}, + receive_hello, + {send, hello}, + + {send, ssh_msg_kexinit}, + {match, #ssh_msg_kexinit{_='_'}, receive_msg}, + + {match, #ssh_msg_kexdh_init{_='_'}, receive_msg}, + {send, ssh_msg_kexdh_reply}, + + {send, #ssh_msg_newkeys{}}, + {match, #ssh_msg_newkeys{_='_'}, receive_msg}, + + {match, #ssh_msg_service_request{name="ssh-userauth"}, receive_msg}, + {send, #ssh_msg_service_accept{name="ssh-userauth"}}, + + {match, #ssh_msg_userauth_request{service="ssh-connection", + method="none", + user=User, + _='_'}, receive_msg}, + {send, #ssh_msg_userauth_failure{authentications = "keyboard-interactive", + partial_success = false}}, + + {match, #ssh_msg_userauth_request{service="ssh-connection", + method="keyboard-interactive", + user=User, + _='_'}, receive_msg}, + {send, #ssh_msg_userauth_info_request{name = "", + instruction = "", + language_tag = "", + num_prompts = 1, + data = <<0,0,0,10,80,97,115,115,119,111,114,100,58,32,0>> + }}, + {match, #ssh_msg_userauth_info_response{num_responses = 1, + _='_'}, receive_msg}, + + %% the next is strange, but openssh 6.6.1 does this and this is what this testcase is about + {send, #ssh_msg_userauth_info_request{name = "", + instruction = "", + language_tag = "", + num_prompts = 0, + data = <<>> + }}, + {match, #ssh_msg_userauth_info_response{num_responses = 0, + data = <<>>, + _='_'}, receive_msg}, + %% Here we know that the tested fault is fixed + {send, #ssh_msg_userauth_success{}}, + close_socket, + print_state + ], + InitialState) + end), + + %% and finally connect to it with a regular Erlang SSH client: + {ok,_} = std_connect(HostPort, Config, + [{preferred_algorithms,[{kex,['diffie-hellman-group1-sha1']}]}] + ). + + %%%================================================================ %%%==== Internal functions ======================================== %%%================================================================ %%%---- init_suite and end_suite --------------------------------------- start_apps(Config) -> - catch crypto:stop(), - case catch crypto:start() of - ok -> - catch ssh:stop(), - ok = ssh:start(), - [{stop_apps, - fun() -> - ssh:stop(), - crypto:stop() - end} | Config]; - _Else -> - {skip, "Crypto could not be started!"} - end. - + catch ssh:stop(), + ok = ssh:start(), + Config. -stop_apps(Config) -> - (?v(stop_apps, Config, fun()-> ok end))(), +stop_apps(_Config) -> ssh:stop(). @@ -644,3 +690,16 @@ connect_and_kex(Config, InitialState) -> {match, #ssh_msg_newkeys{_='_'}, receive_msg} ], InitialState). + +%%%---------------------------------------------------------------- + +%%% For matching peer disconnection +disconnect() -> + disconnect('_'). + +disconnect(Code) -> + {'or',[#ssh_msg_disconnect{code = Code, + _='_'}, + tcp_closed, + {tcp_error,econnaborted} + ]}. diff --git a/lib/ssh/test/ssh_renegotiate_SUITE.erl b/lib/ssh/test/ssh_renegotiate_SUITE.erl index e5cfa58bad..fabe9a5829 100644 --- a/lib/ssh/test/ssh_renegotiate_SUITE.erl +++ b/lib/ssh/test/ssh_renegotiate_SUITE.erl @@ -30,7 +30,9 @@ %% Common Test interface functions ----------------------------------- %%-------------------------------------------------------------------- -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,15}}]. + all() -> [{group,default_algs}, {group,aes_gcm} @@ -44,16 +46,10 @@ tests() -> [rekey, rekey_limit, renegotiate1, renegotiate2]. %%-------------------------------------------------------------------- init_per_suite(Config) -> - catch crypto:stop(), - case catch crypto:start() of - ok -> - Config; - _Else -> - {skip, "Crypto could not be started!"} - end. + Config. + end_per_suite(_Config) -> - ssh:stop(), - crypto:stop(). + ssh:stop(). %%-------------------------------------------------------------------- init_per_group(aes_gcm, Config) -> diff --git a/lib/ssh/test/ssh_sftp_SUITE.erl b/lib/ssh/test/ssh_sftp_SUITE.erl index 698af259c8..6066221fc7 100644 --- a/lib/ssh/test/ssh_sftp_SUITE.erl +++ b/lib/ssh/test/ssh_sftp_SUITE.erl @@ -35,7 +35,9 @@ %%-------------------------------------------------------------------- suite() -> - [{ct_hooks,[ts_install_cth]}]. + [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,5}}]. + all() -> [{group, not_unicode}, @@ -44,22 +46,14 @@ all() -> init_per_suite(Config) -> - catch crypto:stop(), - case (catch crypto:start()) of - ok -> - ct:log("file:native_name_encoding() = ~p,~nio:getopts() = ~p", - [file:native_name_encoding(),io:getopts()]), - ssh:start(), - Config; - _ -> - {skip,"Could not start crypto!"} - end. - -end_per_suite(Config) -> - ssh:stop(), - crypto:stop(), + ct:log("file:native_name_encoding() = ~p,~nio:getopts() = ~p", + [file:native_name_encoding(),io:getopts()]), + ssh:start(), Config. +end_per_suite(_onfig) -> + ssh:stop(). + %%-------------------------------------------------------------------- groups() -> [{not_unicode, [], [{group,erlang_server}, diff --git a/lib/ssh/test/ssh_sftpd_SUITE.erl b/lib/ssh/test/ssh_sftpd_SUITE.erl index 6b03a2b763..687f327206 100644 --- a/lib/ssh/test/ssh_sftpd_SUITE.erl +++ b/lib/ssh/test/ssh_sftpd_SUITE.erl @@ -44,6 +44,9 @@ %% Common Test interface functions ----------------------------------- %%-------------------------------------------------------------------- +suite() -> + [{timetrap,{minutes,5}}]. + all() -> [open_close_file, open_close_dir, @@ -69,28 +72,21 @@ groups() -> %%-------------------------------------------------------------------- init_per_suite(Config) -> - catch crypto:stop(), - case (catch crypto:start()) of - ok -> - DataDir = ?config(data_dir, Config), - PrivDir = ?config(priv_dir, Config), - ssh_test_lib:setup_dsa(DataDir, PrivDir), - %% to make sure we don't use public-key-auth - %% this should be tested by other test suites - UserDir = filename:join(?config(priv_dir, Config), nopubkey), - file:make_dir(UserDir), - Config; - _ -> - {skip,"Could not start crypto!"} - end. + DataDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), + ssh_test_lib:setup_dsa(DataDir, PrivDir), + %% to make sure we don't use public-key-auth + %% this should be tested by other test suites + UserDir = filename:join(?config(priv_dir, Config), nopubkey), + file:make_dir(UserDir), + Config. end_per_suite(Config) -> SysDir = ?config(priv_dir, Config), ssh_test_lib:clean_dsa(SysDir), UserDir = filename:join(?config(priv_dir, Config), nopubkey), file:del_dir(UserDir), - ssh:stop(), - crypto:stop(). + ssh:stop(). %%-------------------------------------------------------------------- diff --git a/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl b/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl index 7a025a6518..84410f60e6 100644 --- a/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl +++ b/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl @@ -36,7 +36,9 @@ %%-------------------------------------------------------------------- suite() -> - [{ct_hooks,[ts_install_cth]}]. + [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,5}}]. + all() -> [close_file, @@ -53,29 +55,22 @@ groups() -> init_per_suite(Config) -> catch ssh:stop(), - catch crypto:stop(), - case catch crypto:start() of - ok -> - DataDir = ?config(data_dir, Config), - PrivDir = ?config(priv_dir, Config), - FileAlt = filename:join(DataDir, "ssh_sftpd_file_alt.erl"), - c:c(FileAlt), - FileName = filename:join(DataDir, "test.txt"), - {ok, FileInfo} = file:read_file_info(FileName), - ok = file:write_file_info(FileName, - FileInfo#file_info{mode = 8#400}), - ssh_test_lib:setup_dsa(DataDir, PrivDir), - Config; - _Else -> - {skip,"Could not start ssh!"} - end. + DataDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), + FileAlt = filename:join(DataDir, "ssh_sftpd_file_alt.erl"), + c:c(FileAlt), + FileName = filename:join(DataDir, "test.txt"), + {ok, FileInfo} = file:read_file_info(FileName), + ok = file:write_file_info(FileName, + FileInfo#file_info{mode = 8#400}), + ssh_test_lib:setup_dsa(DataDir, PrivDir), + Config. end_per_suite(Config) -> UserDir = filename:join(?config(priv_dir, Config), nopubkey), file:del_dir(UserDir), SysDir = ?config(priv_dir, Config), ssh_test_lib:clean_dsa(SysDir), - crypto:stop(), ok. %%-------------------------------------------------------------------- diff --git a/lib/ssh/test/ssh_test_cli.erl b/lib/ssh/test/ssh_test_cli.erl index cd9ad5f2ff..697ddb730d 100644 --- a/lib/ssh/test/ssh_test_cli.erl +++ b/lib/ssh/test/ssh_test_cli.erl @@ -4,20 +4,25 @@ -record(state, { type, + tmpdir, id, ref, port }). -init([Type]) -> - {ok, #state{type = Type}}. + +init([Type]) -> init([Type,"/tmp"]); + +init([Type,TmpDir]) -> + {ok, #state{type = Type, + tmpdir = TmpDir}}. handle_msg({ssh_channel_up, Id, Ref}, S) -> User = get_ssh_user(Ref), ok = ssh_connection:send(Ref, Id, << "\r\nYou are accessing a dummy, type \"q\" to exit\r\n\n" >>), - Port = run_portprog(User, S#state.type), + Port = run_portprog(User, S#state.type, S#state.tmpdir), {ok, S#state{port = Port, id = Id, ref = Ref}}; handle_msg({Port, {data, Data}}, S = #state{port = Port}) -> @@ -68,10 +73,10 @@ handle_ssh_msg({ssh_cm, _, {exit_signal, Id, _, _, _}}, terminate(_Why, _S) -> nop. -run_portprog(User, cli) -> +run_portprog(User, cli, TmpDir) -> Pty_bin = os:find_executable("cat"), open_port({spawn_executable, Pty_bin}, - [stream, {cd, "/tmp"}, {env, [{"USER", User}]}, + [stream, {cd, TmpDir}, {env, [{"USER", User}]}, {args, []}, binary, exit_status, use_stdio, stderr_to_stdout]). diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl index ed76f4f795..5f91fb627a 100644 --- a/lib/ssh/test/ssh_test_lib.erl +++ b/lib/ssh/test/ssh_test_lib.erl @@ -120,7 +120,8 @@ std_simple_exec(Host, Port, Config, Opts) -> Other -> ct:fail(Other) end, - ssh_test_lib:receive_exec_end(ConnectionRef, ChannelId). + ssh_test_lib:receive_exec_end(ConnectionRef, ChannelId), + ssh:close(ConnectionRef). start_shell(Port, IOServer, UserDir) -> @@ -154,14 +155,12 @@ loop_io_server(TestCase, Buff0) -> {input, TestCase, Line} -> loop_io_server(TestCase, Buff0 ++ [Line]); {io_request, From, ReplyAs, Request} -> -%%ct:log("~p",[{io_request, From, ReplyAs, Request}]), {ok, Reply, Buff} = io_request(Request, TestCase, From, ReplyAs, Buff0), -%%ct:log("io_request(~p)-->~p",[Request,{ok, Reply, Buff}]), io_reply(From, ReplyAs, Reply), loop_io_server(TestCase, Buff); - {'EXIT',_, _} -> - erlang:display('ssh_test_lib:loop_io_server/2 EXIT'), + {'EXIT',_, _} = _Exit -> +%% ct:log("ssh_test_lib:loop_io_server/2 got ~p",[_Exit]), ok after 30000 -> ct:fail("timeout ~p:~p",[?MODULE,?LINE]) @@ -541,7 +540,6 @@ default_algorithms(sshc, DaemonOptions) -> ct:fail("No server respons 2") end. - run_fake_ssh({ok,InitialState}) -> KexInitPattern = #ssh_msg_kexinit{ @@ -583,6 +581,40 @@ run_fake_ssh({ok,InitialState}) -> {server2client, to_atoms(CompS2C)}]}]. +%%%---------------------------------------------------------------- +extract_algos(Spec) -> + [{Tag,get_atoms(List)} || {Tag,List} <- Spec]. + +get_atoms(L) -> + lists:usort( + [ A || X <- L, + A <- case X of + {_,L1} when is_list(L1) -> L1; + Y when is_atom(Y) -> [Y] + end]). + + +intersection(AlgoSpec1, AlgoSpec2) -> intersect(sort_spec(AlgoSpec1), sort_spec(AlgoSpec2)). + +intersect([{Tag,S1}|Ss1], [{Tag,S2}|Ss2]) -> + [{Tag,intersect(S1,S2)} | intersect(Ss1,Ss2)]; +intersect(L1=[A1|_], L2=[A2|_]) when is_atom(A1),is_atom(A2) -> + Diff = L1 -- L2, + L1 -- Diff; +intersect(_, _) -> + []. + +intersect_bi_dir([{Tag,[{client2server,L1},{server2client,L2}]}|T]) -> + [{Tag,intersect(L1,L2)} | intersect_bi_dir(T)]; +intersect_bi_dir([H={_,[A|_]}|T]) when is_atom(A) -> + [H | intersect_bi_dir(T)]; +intersect_bi_dir([]) -> + []. + + +sort_spec(L = [{_,_}|_] ) -> [{Tag,sort_spec(Es)} || {Tag,Es} <- L]; +sort_spec(L) -> lists:usort(L). + %%-------------------------------------------------------------------- sshc(Tag) -> to_atoms( diff --git a/lib/ssh/test/ssh_to_openssh_SUITE.erl b/lib/ssh/test/ssh_to_openssh_SUITE.erl index 02cc79e4d5..37885dfdef 100644 --- a/lib/ssh/test/ssh_to_openssh_SUITE.erl +++ b/lib/ssh/test/ssh_to_openssh_SUITE.erl @@ -33,6 +33,9 @@ %% Common Test interface functions ----------------------------------- %%-------------------------------------------------------------------- +suite() -> + [{timetrap,{minutes,5}}]. + all() -> case os:find_executable("ssh") of false -> @@ -57,21 +60,14 @@ groups() -> ]. init_per_suite(Config) -> - catch crypto:stop(), - case catch crypto:start() of - ok -> - case gen_tcp:connect("localhost", 22, []) of - {error,econnrefused} -> - {skip,"No openssh deamon"}; - _ -> - ssh_test_lib:openssh_sanity_check(Config) - end; - _Else -> - {skip,"Could not start crypto!"} + case gen_tcp:connect("localhost", 22, []) of + {error,econnrefused} -> + {skip,"No openssh deamon"}; + _ -> + ssh_test_lib:openssh_sanity_check(Config) end. end_per_suite(_Config) -> - crypto:stop(), ok. init_per_group(erlang_server, Config) -> @@ -110,9 +106,9 @@ end_per_testcase(_TestCase, _Config) -> chk_key(Pgm, Name, File, Config) -> case ssh_test_lib:openssh_supports(Pgm, public_key, Name) of - true -> - {skip,lists:concat(["openssh client does not support ",Name])}; false -> + {skip,lists:concat(["openssh client does not support ",Name])}; + true -> {ok,[[Home]]} = init:get_argument(home), KeyFile = filename:join(Home, File), case file:read_file(KeyFile) of diff --git a/lib/ssh/test/ssh_upgrade_SUITE.erl b/lib/ssh/test/ssh_upgrade_SUITE.erl index 85f4d36258..006483d3ee 100644 --- a/lib/ssh/test/ssh_upgrade_SUITE.erl +++ b/lib/ssh/test/ssh_upgrade_SUITE.erl @@ -38,6 +38,9 @@ %%% %%% CommonTest callbacks %%% +suite() -> + [{timetrap,{minutes,5}}]. + all() -> [ minor_upgrade, @@ -45,27 +48,17 @@ all() -> ]. init_per_suite(Config0) -> - catch crypto:stop(), - try {crypto:start(), erlang:system_info({wordsize, internal}) == - erlang:system_info({wordsize, external})} of - {ok, true} -> - case ct_release_test:init(Config0) of - {skip, Reason} -> - {skip, Reason}; - Config -> - ssh:start(), - Config - end; - {ok, false} -> - {skip, "Test server will not handle halfwordemulator correctly. Skip as halfwordemulator is deprecated"} - catch _:_ -> - {skip, "Crypto did not start"} + case ct_release_test:init(Config0) of + {skip, Reason} -> + {skip, Reason}; + Config -> + ssh:start(), + Config end. end_per_suite(Config) -> ct_release_test:cleanup(Config), ssh:stop(), - crypto:stop(), UserDir = ?config(priv_dir, Config), ssh_test_lib:clean_rsa(UserDir). diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk index 25b19133b1..55d12abffe 100644 --- a/lib/ssh/vsn.mk +++ b/lib/ssh/vsn.mk @@ -1,5 +1,5 @@ #-*-makefile-*- ; force emacs to enter makefile-mode -SSH_VSN = 4.2 +SSH_VSN = 4.2.1 APP_VSN = "ssh-$(SSH_VSN)" diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index bf87644116..d3881ad117 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -144,7 +144,9 @@ <p>According to old API.</p></item> <tag><c>ciphersuite() =</c></tag> - <item><p><c>{key_exchange(), cipher(), hash()}</c></p></item> + + <item><p><c>{key_exchange(), cipher(), MAC::hash()} | + {key_exchange(), cipher(), MAC::hash(), PRF::hash()}</c></p></item> <tag><c>key_exchange()=</c></tag> <item><p><c>rsa | dhe_dss | dhe_rsa | dh_anon | psk | dhe_psk @@ -156,7 +158,7 @@ | aes_128_cbc | aes_256_cbc | aes_128_gcm | aes_256_gcm</c></p></item> <tag><c>hash() =</c></tag> - <item><p><c>md5 | sha</c></p></item> + <item><p><c>md5 | sha | sha224 | sha256 | sha348 | sha512</c></p></item> <tag><c>prf_random() =</c></tag> <item><p><c>client_random | server_random</c></p></item> @@ -221,7 +223,7 @@ <url href="http://www.ietf.org/rfc/rfc5746.txt">RFC 5746</url>. By default <c>secure_renegotiate</c> is set to <c>false</c>, that is, secure renegotiation is used if possible, - but it fallback to unsecure renegotiation if the peer + but it falls back to insecure renegotiation if the peer does not support <url href="http://www.ietf.org/rfc/rfc5746.txt">RFC 5746</url>.</p> </item> @@ -307,7 +309,7 @@ atom()}} | <tag><c>unknown_ca</c></tag> <item><p>No trusted CA was found in the trusted store. The trusted CA is normally a so called ROOT CA, which is a self-signed certificate. Trust can - be claimed for an intermediat CA (trusted anchor does not have to be + be claimed for an intermediate CA (trusted anchor does not have to be self-signed according to X-509) by using option <c>partial_chain</c>.</p> </item> @@ -352,7 +354,7 @@ marker="public_key:public_key#pkix_path_validation-3">public_key:pkix_path_valid <tag><c>{http, timeout()}</c></tag> <item><p> Enables fetching of CRLs specified as http URIs in<seealso - marker="public_key:public_key_records"> X509 cerificate extensions.</seealso> + marker="public_key:public_key_records"> X509 certificate extensions.</seealso> Requires the OTP inets application.</p> </item> </taglist> @@ -611,14 +613,14 @@ fun(srp, Username :: string(), UserState :: term()) -> <tag><c>{sni_hosts, [{hostname(), ssloptions()}]}</c></tag> <item><p>If the server receives a SNI (Server Name Indication) from the client - matching a host listed in the <c>sni_hosts</c> option, the speicific options for + matching a host listed in the <c>sni_hosts</c> option, the specific options for that host will override previously specified options. The option <c>sni_fun</c>, and <c>sni_hosts</c> are mutually exclusive.</p></item> <tag><c>{sni_fun, SNIfun::fun()}</c></tag> <item><p>If the server receives a SNI (Server Name Indication) from the client, - the given function will be called to retrive <c>ssloptions()</c> for indicated server. + the given function will be called to retrieve <c>ssloptions()</c> for the indicated server. These options will be merged into predefined <c>ssloptions()</c>. The function should be defined as: @@ -632,7 +634,7 @@ fun(srp, Username :: string(), UserState :: term()) -> of resources of such an operation is higher for the server than the client. This can act as a vector for denial of service attacks. The SSL application already takes measures to counter-act such attempts, - but client-initiated renegotiation can be stricly disabled by setting + but client-initiated renegotiation can be strictly disabled by setting this option to <c>false</c>. The default value is <c>true</c>. Note that disabling renegotiation can result in long-lived connections becoming unusable due to limits on the number of messages the underlying @@ -748,26 +750,13 @@ fun(srp, Username :: string(), UserState :: term()) -> <v>How = timeout() | {NewController::pid(), timeout()} </v> <v>Reason = term()</v> </type> - <desc><p>Closes or downgrades an SSL connection, in the later case the transport - connection will be handed over to the <c>NewController</c> process after reciving - the TLS close alert from the peer. The retuned transport socket will have - the following options set [{active, false}, {packet, 0}, {mode, binary}].</p> - </desc> - </func> - - <func> - <name>connection_info(SslSocket) -> - {ok, {ProtocolVersion, CipherSuite}} | {error, Reason}</name> - <fsummary>Returns the Negotiated Protocol version and cipher suite. - </fsummary> - <type> - <v>CipherSuite = ciphersuite()</v> - <v>ProtocolVersion = protocol()</v> - </type> - <desc><p>Returns the Negotiated Protocol version and cipher suite.</p> + <desc><p>Closes or downgrades an SSL connection. In the latter case the transport + connection will be handed over to the <c>NewController</c> process after receiving + the TLS close alert from the peer. The returned transport socket will have + the following options set: <c>[{active, false}, {packet, 0}, {mode, binary}]</c></p> </desc> </func> - + <func> <name>controlling_process(SslSocket, NewOwner) -> ok | {error, Reason}</name> @@ -786,40 +775,36 @@ fun(srp, Username :: string(), UserState :: term()) -> <func> <name>connection_information(SslSocket) -> - {ok, Info} | {error, Reason} </name> + {ok, Result} | {error, Reason} </name> <fsummary>Returns all the connection information. </fsummary> <type> - <v>Info = [InfoTuple]</v> - <v>InfoTuple = {protocol, Protocol} | {cipher_suite, CipherSuite} | {sni_hostname, SNIHostname}</v> - <v>CipherSuite = ciphersuite()</v> - <v>ProtocolVersion = protocol()</v> - <v>SNIHostname = string()</v> + <v>Item = protocol | cipher_suite | sni_hostname | atom()</v> + <d>Meaningful atoms, not specified above, are the ssl option names.</d> + <v>Result = [{Item::atom(), Value::term()}]</v> <v>Reason = term()</v> </type> - <desc><p>Return all the connection information containing negotiated protocol version, cipher suite, and the hostname of SNI extension. - Info will be a proplists containing all the connection information on success, otherwise <c>{error, Reason}</c> will be returned.</p> + <desc><p>Returns all relevant information about the connection, ssl options that + are undefined will be filtered out.</p> </desc> </func> <func> <name>connection_information(SslSocket, Items) -> - {ok, Info} | {error, Reason} </name> + {ok, Result} | {error, Reason} </name> <fsummary>Returns the requested connection information. </fsummary> <type> - <v>Items = [Item]</v> - <v>Item = protocol | cipher_suite | sni_hostname</v> - <v>Info = [InfoTuple]</v> - <v>InfoTuple = {protocol, Protocol} | {cipher_suite, CipherSuite} | {sni_hostname, SNIHostname}</v> - <v>CipherSuite = ciphersuite()</v> - <v>ProtocolVersion = protocol()</v> - <v>SNIHostname = string()</v> + <v>Items = [Item]</v> + <v>Item = protocol | cipher_suite | sni_hostname | atom()</v> + <d>Meaningful atoms, not specified above, are the ssl option names.</d> + <v>Result = [{Item::atom(), Value::term()}]</v> <v>Reason = term()</v> </type> - <desc><p>Returns the connection information you requested. The connection information you can request contains protocol, cipher_suite, and sni_hostname. - <c>{ok, Info}</c> will be returned if it executes sucessfully. The Info is a proplists containing the information you requested. - Otherwise, <c>{error, Reason}</c> will be returned.</p> + <desc><p>Returns the requested information items about the connection, + if they are defined.</p> + <note><p>If only undefined options are requested the + resulting list can be empty.</p></note> </desc> </func> @@ -1146,7 +1131,7 @@ fun(srp, Username :: string(), UserState :: term()) -> <seealso marker="#listen-2"> listen/2</seealso>, and <seealso marker="#ssl_accept-2">ssl_accept/[1,2,3]</seealso>. For the negotiated TLS/SSL version, see <seealso - marker="#connection_info-1">ssl:connection_info/1 + marker="#connection_information-1">ssl:connection_information/1 </seealso>.</item> <tag><c>available</c></tag> diff --git a/lib/ssl/doc/src/ssl_app.xml b/lib/ssl/doc/src/ssl_app.xml index 6c82e32a74..d05ece3971 100644 --- a/lib/ssl/doc/src/ssl_app.xml +++ b/lib/ssl/doc/src/ssl_app.xml @@ -43,6 +43,8 @@ <item>For security reasons SSL-2.0 is not supported.</item> <item>For security reasons SSL-3.0 is no longer supported by default, but can be configured.</item> + <item>For security reasons DES cipher suites are no longer supported by default, + but can be configured.</item> <item>Ephemeral Diffie-Hellman cipher suites are supported, but not Diffie Hellman Certificates cipher suites.</item> <item>Elliptic Curve cipher suites are supported if the Crypto @@ -55,8 +57,8 @@ motivated to implement them.</item> <item>CRL validation is supported.</item> <item>Policy certificate extensions are not supported.</item> - <item>'Server Name Indication' extension client side - (RFC 6066, Section 3) is supported.</item> + <item>'Server Name Indication' extension + (<url href="http://www.ietf.org/rfc/rfc6066.txt">RFC 6066</url>) is supported.</item> </list> </description> diff --git a/lib/ssl/src/inet_tls_dist.erl b/lib/ssl/src/inet_tls_dist.erl index 404ae93d20..6fe99a81c5 100644 --- a/lib/ssl/src/inet_tls_dist.erl +++ b/lib/ssl/src/inet_tls_dist.erl @@ -76,23 +76,23 @@ do_setup(Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) -> Timer, Version, Ip, TcpPort, Address, Type), dist_util:handshake_we_started(HSData); - _ -> + Other -> %% Other Node may have closed since %% port_please ! ?trace("other node (~p) " "closed since port_please.~n", [Node]), - ?shutdown(Node) + ?shutdown2(Node, {shutdown, {connect_failed, Other}}) end; - _ -> + Other -> ?trace("port_please (~p) " "failed.~n", [Node]), - ?shutdown(Node) + ?shutdown2(Node, {shutdown, {port_please_failed, Other}}) end; - _Other -> + Other -> ?trace("inet_getaddr(~p) " "failed (~p).~n", [Node,Other]), - ?shutdown(Node) + ?shutdown2(Node, {shutdown, {inet_getaddr_failed, Other}}) end. close(Socket) -> diff --git a/lib/ssl/src/ssl.appup.src b/lib/ssl/src/ssl.appup.src index 11728128c4..057906bcb3 100644 --- a/lib/ssl/src/ssl.appup.src +++ b/lib/ssl/src/ssl.appup.src @@ -1,6 +1,9 @@ %% -*- erlang -*- {"%VSN%", [ + {<<"7\\.2">>, [{load_module, tls_connection, soft_purge, soft_purge, []}, + {load_module, ssl_tls_dist_proxy, soft_purge, soft_purge, []} + ]}, {<<"7\\..*">>, [{restart_application, ssl}]}, {<<"6\\..*">>, [{restart_application, ssl}]}, {<<"5\\..*">>, [{restart_application, ssl}]}, @@ -8,6 +11,9 @@ {<<"3\\..*">>, [{restart_application, ssl}]} ], [ + {<<"7\\.2">>, [{load_module, tls_connection, soft_purge, soft_purge, []}, + {load_module, ssl_tls_dist_proxy, soft_purge, soft_purge, []} + ]}, {<<"7\\..*">>, [{restart_application, ssl}]}, {<<"6\\..*">>, [{restart_application, ssl}]}, {<<"5\\..*">>, [{restart_application, ssl}]}, diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 6551308935..c1bc90559e 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -37,7 +37,7 @@ close/1, close/2, shutdown/2, recv/2, recv/3, send/2, getopts/2, setopts/2 ]). %% SSL/TLS protocol handling --export([cipher_suites/0, cipher_suites/1, suite_definition/1, +-export([cipher_suites/0, cipher_suites/1, connection_info/1, versions/0, session_info/1, format_error/1, renegotiate/1, prf/5, negotiated_protocol/1, negotiated_next_protocol/1, connection_information/1, connection_information/2]). @@ -105,7 +105,7 @@ connect(Socket, SslOptions0, Timeout) when is_port(Socket), {gen_tcp, tcp, tcp_closed, tcp_error}), EmulatedOptions = ssl_socket:emulated_options(), {ok, SocketValues} = ssl_socket:getopts(Transport, Socket, EmulatedOptions), - try handle_options(SslOptions0 ++ SocketValues) of + try handle_options(SslOptions0 ++ SocketValues, client) of {ok, #config{transport_info = CbInfo, ssl = SslOptions, emulated = EmOpts, connection_cb = ConnectionCb}} -> @@ -127,7 +127,7 @@ connect(Host, Port, Options) -> connect(Host, Port, Options, infinity). connect(Host, Port, Options, Timeout) when (is_integer(Timeout) andalso Timeout > 0) or (Timeout == infinity) -> - try handle_options(Options) of + try handle_options(Options, client) of {ok, Config} -> do_connect(Host,Port,Config,Timeout) catch @@ -145,7 +145,7 @@ listen(_Port, []) -> {error, nooptions}; listen(Port, Options0) -> try - {ok, Config} = handle_options(Options0), + {ok, Config} = handle_options(Options0, server), ConnectionCb = connection_cb(Options0), #config{transport_info = {Transport, _, _, _}, inet_user = Options, connection_cb = ConnectionCb, ssl = SslOpts, emulated = EmOpts} = Config, @@ -233,7 +233,7 @@ ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket), EmulatedOptions = ssl_socket:emulated_options(), {ok, SocketValues} = ssl_socket:getopts(Transport, Socket, EmulatedOptions), ConnetionCb = connection_cb(SslOptions), - try handle_options(SslOptions ++ SocketValues) of + try handle_options(SslOptions ++ SocketValues, server) of {ok, #config{transport_info = CbInfo, ssl = SslOpts, emulated = EmOpts}} -> ok = ssl_socket:setopts(Transport, Socket, ssl_socket:internal_inet_values()), {ok, Port} = ssl_socket:port(Transport, Socket), @@ -315,24 +315,32 @@ controlling_process(#sslsocket{pid = {Listen, %% %% Description: Return SSL information for the connection %%-------------------------------------------------------------------- -connection_information(#sslsocket{pid = Pid}) when is_pid(Pid) -> ssl_connection:connection_information(Pid); -connection_information(#sslsocket{pid = {Listen, _}}) when is_port(Listen) -> {error, enotconn}. - +connection_information(#sslsocket{pid = Pid}) when is_pid(Pid) -> + case ssl_connection:connection_information(Pid) of + {ok, Info} -> + {ok, [Item || Item = {_Key, Value} <- Info, Value =/= undefined]}; + Error -> + Error + end; +connection_information(#sslsocket{pid = {Listen, _}}) when is_port(Listen) -> + {error, enotconn}. %%-------------------------------------------------------------------- --spec connection_information(#sslsocket{}, [atom]) -> {ok, list()} | {error, reason()}. +-spec connection_information(#sslsocket{}, [atom()]) -> {ok, list()} | {error, reason()}. %% %% Description: Return SSL information for the connection %%-------------------------------------------------------------------- connection_information(#sslsocket{} = SSLSocket, Items) -> case connection_information(SSLSocket) of - {ok, I} -> - {ok, lists:filter(fun({K, _}) -> lists:foldl(fun(K1, Acc) when K1 =:= K -> Acc + 1; (_, Acc) -> Acc end, 0, Items) > 0 end, I)}; - E -> - E + {ok, Info} -> + {ok, [Item || Item = {Key, Value} <- Info, lists:member(Key, Items), + Value =/= undefined]}; + Error -> + Error end. %%-------------------------------------------------------------------- +%% Deprecated -spec connection_info(#sslsocket{}) -> {ok, {tls_record:tls_atom_version(), ssl_cipher:erl_cipher_suite()}} | {error, reason()}. %% @@ -372,15 +380,6 @@ peercert(#sslsocket{pid = {Listen, _}}) when is_port(Listen) -> {error, enotconn}. %%-------------------------------------------------------------------- --spec suite_definition(ssl_cipher:cipher_suite()) -> ssl_cipher:erl_cipher_suite(). -%% -%% Description: Return erlang cipher suite definition. -%%-------------------------------------------------------------------- -suite_definition(S) -> - {KeyExchange, Cipher, Hash, _} = ssl_cipher:suite_definition(S), - {KeyExchange, Cipher, Hash}. - -%%-------------------------------------------------------------------- -spec negotiated_protocol(#sslsocket{}) -> {ok, binary()} | {error, reason()}. %% %% Description: Returns the protocol that has been negotiated. If no @@ -410,7 +409,7 @@ negotiated_next_protocol(Socket) -> %%-------------------------------------------------------------------- cipher_suites(erlang) -> Version = tls_record:highest_protocol_version([]), - ssl_cipher:filter_suites([suite_definition(S) + ssl_cipher:filter_suites([ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:suites(Version)]); cipher_suites(openssl) -> Version = tls_record:highest_protocol_version([]), @@ -418,7 +417,7 @@ cipher_suites(openssl) -> || S <- ssl_cipher:filter_suites(ssl_cipher:suites(Version))]; cipher_suites(all) -> Version = tls_record:highest_protocol_version([]), - ssl_cipher:filter_suites([suite_definition(S) + ssl_cipher:filter_suites([ssl_cipher:erl_suite_definition(S) || S <-ssl_cipher:all_suites(Version)]). cipher_suites() -> cipher_suites(erlang). @@ -630,7 +629,8 @@ handle_options(Opts0, #ssl_options{protocol = Protocol, cacerts = CaCerts0, cacertfile = CaCertFile0} = InheritedSslOpts) -> RecordCB = record_cb(Protocol), CaCerts = handle_option(cacerts, Opts0, CaCerts0), - {Verify, FailIfNoPeerCert, CaCertDefault, VerifyFun, PartialChainHanlder} = handle_verify_options(Opts0, CaCerts), + {Verify, FailIfNoPeerCert, CaCertDefault, VerifyFun, PartialChainHanlder, + VerifyClientOnce} = handle_verify_options(Opts0, CaCerts), CaCertFile = case proplists:get_value(cacertfile, Opts0, CaCertFile0) of undefined -> CaCertDefault; @@ -643,11 +643,12 @@ handle_options(Opts0, #ssl_options{protocol = Protocol, cacerts = CaCerts0, verify = Verify, verify_fun = VerifyFun, partial_chain = PartialChainHanlder, - fail_if_no_peer_cert = FailIfNoPeerCert}, + fail_if_no_peer_cert = FailIfNoPeerCert, + verify_client_once = VerifyClientOnce}, SslOpts1 = lists:foldl(fun(Key, PropList) -> proplists:delete(Key, PropList) end, Opts0, [cacerts, cacertfile, verify, verify_fun, partial_chain, - fail_if_no_peer_cert]), + fail_if_no_peer_cert, verify_client_once]), case handle_option(versions, SslOpts1, []) of [] -> new_ssl_options(SslOpts1, NewVerifyOpts, RecordCB); @@ -655,10 +656,10 @@ handle_options(Opts0, #ssl_options{protocol = Protocol, cacerts = CaCerts0, Versions = [RecordCB:protocol_version(Vsn) || Vsn <- Value], new_ssl_options(proplists:delete(versions, SslOpts1), NewVerifyOpts#ssl_options{versions = Versions}, record_cb(Protocol)) - end. + end; %% Handle all options in listen and connect -handle_options(Opts0) -> +handle_options(Opts0, Role) -> Opts = proplists:expand([{binary, [{mode, binary}]}, {list, [{mode, list}]}], Opts0), assert_proplist(Opts), @@ -667,7 +668,7 @@ handle_options(Opts0) -> ReuseSessionFun = fun(_, _, _, _) -> true end, CaCerts = handle_option(cacerts, Opts, undefined), - {Verify, FailIfNoPeerCert, CaCertDefault, VerifyFun, PartialChainHanlder} = + {Verify, FailIfNoPeerCert, CaCertDefault, VerifyFun, PartialChainHanlder, VerifyClientOnce} = handle_verify_options(Opts, CaCerts), CertFile = handle_option(certfile, Opts, <<>>), @@ -686,7 +687,7 @@ handle_options(Opts0) -> verify_fun = VerifyFun, partial_chain = PartialChainHanlder, fail_if_no_peer_cert = FailIfNoPeerCert, - verify_client_once = handle_option(verify_client_once, Opts, false), + verify_client_once = VerifyClientOnce, depth = handle_option(depth, Opts, 1), cert = handle_option(cert, Opts, undefined), certfile = CertFile, @@ -706,7 +707,9 @@ handle_options(Opts0) -> reuse_session = handle_option(reuse_session, Opts, ReuseSessionFun), reuse_sessions = handle_option(reuse_sessions, Opts, true), secure_renegotiate = handle_option(secure_renegotiate, Opts, false), - client_renegotiation = handle_option(client_renegotiation, Opts, true), + client_renegotiation = handle_option(client_renegotiation, Opts, + default_option_role(server, true, Role), + server, Role), renegotiate_at = handle_option(renegotiate_at, Opts, ?DEFAULT_RENEGOTIATE_AT), hibernate_after = handle_option(hibernate_after, Opts, undefined), erl_dist = handle_option(erl_dist, Opts, false), @@ -723,10 +726,16 @@ handle_options(Opts0) -> server_name_indication = handle_option(server_name_indication, Opts, undefined), sni_hosts = handle_option(sni_hosts, Opts, []), sni_fun = handle_option(sni_fun, Opts, undefined), - honor_cipher_order = handle_option(honor_cipher_order, Opts, false), + honor_cipher_order = handle_option(honor_cipher_order, Opts, + default_option_role(server, false, Role), + server, Role), protocol = proplists:get_value(protocol, Opts, tls), padding_check = proplists:get_value(padding_check, Opts, true), - fallback = proplists:get_value(fallback, Opts, false), + fallback = handle_option(fallback, Opts, + proplists:get_value(fallback, Opts, + default_option_role(client, + false, Role)), + client, Role), crl_check = handle_option(crl_check, Opts, false), crl_cache = handle_option(crl_cache, Opts, {ssl_crl_cache, {internal, []}}) }, @@ -756,6 +765,13 @@ handle_options(Opts0) -> inet_user = SockOpts, transport_info = CbInfo, connection_cb = ConnetionCb }}. + + +handle_option(OptionName, Opts, Default, Role, Role) -> + handle_option(OptionName, Opts, Default); +handle_option(_, _, undefined = Value, _, _) -> + Value. + handle_option(sni_fun, Opts, Default) -> OptFun = validate_option(sni_fun, proplists:get_value(sni_fun, Opts, Default)), @@ -772,7 +788,6 @@ handle_option(OptionName, Opts, Default) -> validate_option(OptionName, proplists:get_value(OptionName, Opts, Default)). - validate_option(versions, Versions) -> validate_versions(Versions, Versions); validate_option(verify, Value) @@ -1216,7 +1231,8 @@ emulated_socket_options(InetValues, #socket_options{ new_ssl_options([], #ssl_options{} = Opts, _) -> Opts; new_ssl_options([{verify_client_once, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> - new_ssl_options(Rest, Opts#ssl_options{verify_client_once = validate_option(verify_client_once, Value)}, RecordCB); + new_ssl_options(Rest, Opts#ssl_options{verify_client_once = + validate_option(verify_client_once, Value)}, RecordCB); new_ssl_options([{depth, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> new_ssl_options(Rest, Opts#ssl_options{depth = validate_option(depth, Value)}, RecordCB); new_ssl_options([{cert, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> @@ -1295,29 +1311,35 @@ handle_verify_options(Opts, CaCerts) -> PartialChainHanlder = handle_option(partial_chain, Opts, fun(_) -> unknown_ca end), + VerifyClientOnce = handle_option(verify_client_once, Opts, false), + %% Handle 0, 1, 2 for backwards compatibility case proplists:get_value(verify, Opts, verify_none) of 0 -> {verify_none, false, ca_cert_default(verify_none, VerifyNoneFun, CaCerts), - VerifyNoneFun, PartialChainHanlder}; + VerifyNoneFun, PartialChainHanlder, VerifyClientOnce}; 1 -> {verify_peer, false, ca_cert_default(verify_peer, UserVerifyFun, CaCerts), - UserVerifyFun, PartialChainHanlder}; + UserVerifyFun, PartialChainHanlder, VerifyClientOnce}; 2 -> {verify_peer, true, ca_cert_default(verify_peer, UserVerifyFun, CaCerts), - UserVerifyFun, PartialChainHanlder}; + UserVerifyFun, PartialChainHanlder, VerifyClientOnce}; verify_none -> {verify_none, false, ca_cert_default(verify_none, VerifyNoneFun, CaCerts), - VerifyNoneFun, PartialChainHanlder}; + VerifyNoneFun, PartialChainHanlder, VerifyClientOnce}; verify_peer -> {verify_peer, UserFailIfNoPeerCert, ca_cert_default(verify_peer, UserVerifyFun, CaCerts), - UserVerifyFun, PartialChainHanlder}; + UserVerifyFun, PartialChainHanlder, VerifyClientOnce}; Value -> throw({error, {options, {verify, Value}}}) end. +default_option_role(Role, Value, Role) -> + Value; +default_option_role(_,_,_) -> + undefined. diff --git a/lib/ssl/src/ssl_certificate.erl b/lib/ssl/src/ssl_certificate.erl index 4658e76ab1..e9dc5764a3 100644 --- a/lib/ssl/src/ssl_certificate.erl +++ b/lib/ssl/src/ssl_certificate.erl @@ -56,15 +56,15 @@ %% errors. Returns {RootCert, Path, VerifyErrors} %%-------------------------------------------------------------------- trusted_cert_and_path(CertChain, CertDbHandle, CertDbRef, PartialChainHandler) -> - Path = [Cert | _] = lists:reverse(CertChain), - OtpCert = public_key:pkix_decode_cert(Cert, otp), + Path = [BinCert | _] = lists:reverse(CertChain), + OtpCert = public_key:pkix_decode_cert(BinCert, otp), SignedAndIssuerID = case public_key:pkix_is_self_signed(OtpCert) of true -> {ok, IssuerId} = public_key:pkix_issuer_id(OtpCert, self), {self, IssuerId}; false -> - other_issuer(OtpCert, CertDbHandle) + other_issuer(OtpCert, BinCert, CertDbHandle) end, case SignedAndIssuerID of @@ -187,7 +187,7 @@ public_key_type(?'id-ecPublicKey') -> %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- -certificate_chain(OtpCert, _Cert, CertDbHandle, CertsDbRef, Chain) -> +certificate_chain(OtpCert, BinCert, CertDbHandle, CertsDbRef, Chain) -> IssuerAndSelfSigned = case public_key:pkix_is_self_signed(OtpCert) of true -> @@ -200,7 +200,7 @@ certificate_chain(OtpCert, _Cert, CertDbHandle, CertsDbRef, Chain) -> {_, true = SelfSigned} -> certificate_chain(CertDbHandle, CertsDbRef, Chain, ignore, ignore, SelfSigned); {{error, issuer_not_found}, SelfSigned} -> - case find_issuer(OtpCert, CertDbHandle) of + case find_issuer(OtpCert, BinCert, CertDbHandle) of {ok, {SerialNr, Issuer}} -> certificate_chain(CertDbHandle, CertsDbRef, Chain, SerialNr, Issuer, SelfSigned); @@ -232,12 +232,12 @@ certificate_chain(CertDbHandle, CertsDbRef, Chain, SerialNr, Issuer, _SelfSigned {ok, undefined, lists:reverse(Chain)} end. -find_issuer(OtpCert, CertDbHandle) -> +find_issuer(OtpCert, BinCert, CertDbHandle) -> IsIssuerFun = fun({_Key, {_Der, #'OTPCertificate'{} = ErlCertCandidate}}, Acc) -> case public_key:pkix_is_issuer(OtpCert, ErlCertCandidate) of true -> - case verify_cert_signer(OtpCert, ErlCertCandidate#'OTPCertificate'.tbsCertificate) of + case verify_cert_signer(BinCert, ErlCertCandidate#'OTPCertificate'.tbsCertificate) of true -> throw(public_key:pkix_issuer_id(ErlCertCandidate, self)); false -> @@ -265,9 +265,9 @@ is_valid_extkey_usage(KeyUse, server) -> %% Server wants to verify client is_valid_key_usage(KeyUse, ?'id-kp-clientAuth'). -verify_cert_signer(OtpCert, SignerTBSCert) -> +verify_cert_signer(BinCert, SignerTBSCert) -> PublicKey = public_key(SignerTBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo), - public_key:pkix_verify(public_key:pkix_encode('OTPCertificate', OtpCert, otp), PublicKey). + public_key:pkix_verify(BinCert, PublicKey). public_key(#'OTPSubjectPublicKeyInfo'{algorithm = #'PublicKeyAlgorithm'{algorithm = ?'id-ecPublicKey', parameters = Params}, @@ -281,12 +281,12 @@ public_key(#'OTPSubjectPublicKeyInfo'{algorithm = #'PublicKeyAlgorithm'{algorith subjectPublicKey = Key}) -> {Key, Params}. -other_issuer(OtpCert, CertDbHandle) -> +other_issuer(OtpCert, BinCert, CertDbHandle) -> case public_key:pkix_issuer_id(OtpCert, other) of {ok, IssuerId} -> {other, IssuerId}; {error, issuer_not_found} -> - case find_issuer(OtpCert, CertDbHandle) of + case find_issuer(OtpCert, BinCert, CertDbHandle) of {ok, IssuerId} -> {other, IssuerId}; Other -> diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index 8c2a16ba96..d737f74aa3 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -34,10 +34,11 @@ -include_lib("public_key/include/public_key.hrl"). -export([security_parameters/2, security_parameters/3, suite_definition/1, + erl_suite_definition/1, cipher_init/3, decipher/6, cipher/5, decipher_aead/6, cipher_aead/6, suite/1, suites/1, all_suites/1, ec_keyed_suites/0, anonymous_suites/1, psk_suites/1, srp_suites/0, - rc4_suites/1, openssl_suite/1, openssl_suite_name/1, filter/2, filter_suites/1, + rc4_suites/1, des_suites/1, openssl_suite/1, openssl_suite_name/1, filter/2, filter_suites/1, hash_algorithm/1, sign_algorithm/1, is_acceptable_hash/2, is_fallback/1]). -export_type([cipher_suite/0, @@ -48,8 +49,11 @@ | aes_128_cbc | aes_256_cbc | aes_128_gcm | aes_256_gcm | chacha20_poly1305. -type hash() :: null | sha | md5 | sha224 | sha256 | sha384 | sha512. -type key_algo() :: null | rsa | dhe_rsa | dhe_dss | ecdhe_ecdsa| ecdh_ecdsa | ecdh_rsa| srp_rsa| srp_dss | psk | dhe_psk | rsa_psk | dh_anon | ecdh_anon | srp_anon. --type erl_cipher_suite() :: {key_algo(), cipher(), hash()}. --type int_cipher_suite() :: {key_algo(), cipher(), hash(), hash() | default_prf}. +-type erl_cipher_suite() :: {key_algo(), cipher(), hash()} % Pre TLS 1.2 + %% TLS 1.2, internally PRE TLS 1.2 will use default_prf + | {key_algo(), cipher(), hash(), hash() | default_prf}. + + -type cipher_suite() :: binary(). -type cipher_enum() :: integer(). -type openssl_cipher_suite() :: string(). @@ -311,7 +315,8 @@ all_suites(Version) -> ++ anonymous_suites(Version) ++ psk_suites(Version) ++ srp_suites() - ++ rc4_suites(Version). + ++ rc4_suites(Version) + ++ des_suites(Version). %%-------------------------------------------------------------------- -spec anonymous_suites(ssl_record:ssl_version() | integer()) -> [cipher_suite()]. %% @@ -415,9 +420,19 @@ rc4_suites({3, N}) when N =< 3 -> ?TLS_RSA_WITH_RC4_128_MD5, ?TLS_ECDH_ECDSA_WITH_RC4_128_SHA, ?TLS_ECDH_RSA_WITH_RC4_128_SHA]. +%%-------------------------------------------------------------------- +-spec des_suites(Version::ssl_record:ssl_version()) -> [cipher_suite()]. +%% +%% Description: Returns a list of the cipher suites +%% with DES cipher, only supported if explicitly set by user. +%% Are not considered secure any more. +%%-------------------------------------------------------------------- +des_suites(_)-> + [?TLS_DHE_RSA_WITH_DES_CBC_SHA, + ?TLS_RSA_WITH_DES_CBC_SHA]. %%-------------------------------------------------------------------- --spec suite_definition(cipher_suite()) -> int_cipher_suite(). +-spec suite_definition(cipher_suite()) -> erl_cipher_suite(). %% %% Description: Return erlang cipher suite definition. %% Note: Currently not supported suites are commented away. @@ -722,6 +737,20 @@ suite_definition(?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256) -> {dhe_rsa, chacha20_poly1305, null, sha256}. %%-------------------------------------------------------------------- +-spec erl_suite_definition(cipher_suite()) -> erl_cipher_suite(). +%% +%% Description: Return erlang cipher suite definition. Filters last value +%% for now (compatibility reasons). +%%-------------------------------------------------------------------- +erl_suite_definition(S) -> + case suite_definition(S) of + {KeyExchange, Cipher, Hash, default_prf} -> + {KeyExchange, Cipher, Hash}; + Suite -> + Suite + end. + +%%-------------------------------------------------------------------- -spec suite(erl_cipher_suite()) -> cipher_suite(). %% %% Description: Return TLS cipher suite definition. @@ -1384,18 +1413,14 @@ filter(DerCert, Ciphers) -> %% %% Description: Filter suites for algorithms supported by crypto. %%------------------------------------------------------------------- -filter_suites(Suites = [{_,_,_}|_]) -> +filter_suites(Suites = [Value|_]) when is_tuple(Value) -> Algos = crypto:supports(), + Hashs = proplists:get_value(hashs, Algos), lists:filter(fun({KeyExchange, Cipher, Hash}) -> is_acceptable_keyexchange(KeyExchange, proplists:get_value(public_keys, Algos)) andalso is_acceptable_cipher(Cipher, proplists:get_value(ciphers, Algos)) andalso - is_acceptable_hash(Hash, proplists:get_value(hashs, Algos)) - end, Suites); - -filter_suites(Suites = [{_,_,_,_}|_]) -> - Algos = crypto:supports(), - Hashs = proplists:get_value(hashs, Algos), - lists:filter(fun({KeyExchange, Cipher, Hash, Prf}) -> + is_acceptable_hash(Hash, proplists:get_value(hashs, Algos)); + ({KeyExchange, Cipher, Hash, Prf}) -> is_acceptable_keyexchange(KeyExchange, proplists:get_value(public_keys, Algos)) andalso is_acceptable_cipher(Cipher, proplists:get_value(ciphers, Algos)) andalso is_acceptable_hash(Hash, Hashs) andalso @@ -1714,7 +1739,8 @@ dhe_rsa_suites() -> ?TLS_DHE_RSA_WITH_DES_CBC_SHA, ?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256, ?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384, - ?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256]. + ?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256 + ]. psk_rsa_suites() -> [?TLS_RSA_PSK_WITH_AES_256_GCM_SHA384, diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 241871dc38..ec7d086934 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -836,15 +836,22 @@ handle_sync_event(session_info, _, StateName, #state{session = #session{session_id = Id, cipher_suite = Suite}} = State) -> {reply, [{session_id, Id}, - {cipher_suite, ssl:suite_definition(Suite)}], + {cipher_suite, ssl_cipher:erl_suite_definition(Suite)}], StateName, State, get_timeout(State)}; handle_sync_event(peer_certificate, _, StateName, #state{session = #session{peer_certificate = Cert}} = State) -> {reply, {ok, Cert}, StateName, State, get_timeout(State)}; -handle_sync_event(connection_information, _, StateName, #state{sni_hostname = SNIHostname, session = #session{cipher_suite = CipherSuite}, negotiated_version = Version} = State) -> - {reply, {ok, [{protocol, tls_record:protocol_version(Version)}, {cipher_suite, ssl:suite_definition(CipherSuite)}, {sni_hostname, SNIHostname}]}, StateName, State, get_timeout(State)}. +handle_sync_event(connection_information, _, StateName, State) -> + Info = connection_info(State), + {reply, {ok, Info}, StateName, State, get_timeout(State)}. +connection_info(#state{sni_hostname = SNIHostname, + session = #session{cipher_suite = CipherSuite}, + negotiated_version = Version, ssl_options = Opts}) -> + [{protocol, tls_record:protocol_version(Version)}, + {cipher_suite, ssl_cipher:erl_suite_definition(CipherSuite)}, + {sni_hostname, SNIHostname}] ++ ssl_options_list(Opts). handle_info({ErrorTag, Socket, econnaborted}, StateName, #state{socket = Socket, transport_cb = Transport, @@ -1885,3 +1892,28 @@ negotiated_hashsign(undefined, Alg, Version) -> negotiated_hashsign(HashSign = {_, _}, _, _) -> HashSign. +ssl_options_list(SslOptions) -> + Fileds = record_info(fields, ssl_options), + Values = tl(tuple_to_list(SslOptions)), + ssl_options_list(Fileds, Values, []). + +ssl_options_list([],[], Acc) -> + lists:reverse(Acc); +%% Skip internal options, only return user options +ssl_options_list([protocol | Keys], [_ | Values], Acc) -> + ssl_options_list(Keys, Values, Acc); +ssl_options_list([erl_dist | Keys], [_ | Values], Acc) -> + ssl_options_list(Keys, Values, Acc); +ssl_options_list([renegotiate_at | Keys], [_ | Values], Acc) -> + ssl_options_list(Keys, Values, Acc); +ssl_options_list([ciphers = Key | Keys], [Value | Values], Acc) -> + ssl_options_list(Keys, Values, + [{Key, lists:map( + fun(Suite) -> + ssl_cipher:erl_suite_definition(Suite) + end, Value)} + | Acc]); +ssl_options_list([Key | Keys], [Value | Values], Acc) -> + ssl_options_list(Keys, Values, [{Key, Value} | Acc]). + + diff --git a/lib/ssl/src/ssl_connection.hrl b/lib/ssl/src/ssl_connection.hrl index 9a58f2b8f7..bb41ef2b62 100644 --- a/lib/ssl/src/ssl_connection.hrl +++ b/lib/ssl/src/ssl_connection.hrl @@ -48,27 +48,28 @@ socket_options :: #socket_options{}, connection_states :: #connection_states{} | secret_printout(), protocol_buffers :: term() | secret_printout() , %% #protocol_buffers{} from tls_record.hrl or dtls_recor.hrl - tls_handshake_history :: ssl_handshake:ssl_handshake_history() | secret_printout(), - cert_db :: reference(), + tls_handshake_history :: ssl_handshake:ssl_handshake_history() | secret_printout() + | 'undefined', + cert_db :: reference() | 'undefined', session :: #session{} | secret_printout(), session_cache :: db_handle(), session_cache_cb :: atom(), crl_db :: term(), - negotiated_version :: ssl_record:ssl_version(), + negotiated_version :: ssl_record:ssl_version() | 'undefined', client_certificate_requested = false :: boolean(), key_algorithm :: ssl_cipher:key_algo(), hashsign_algorithm = {undefined, undefined}, cert_hashsign_algorithm, - public_key_info :: ssl_handshake:public_key_info(), - private_key :: public_key:private_key() | secret_printout(), + public_key_info :: ssl_handshake:public_key_info() | 'undefined', + private_key :: public_key:private_key() | secret_printout() | 'undefined', diffie_hellman_params:: #'DHParameter'{} | undefined | secret_printout(), diffie_hellman_keys :: {PublicKey :: binary(), PrivateKey :: binary()} | #'ECPrivateKey'{} | undefined | secret_printout(), - psk_identity :: binary(), % server psk identity hint - srp_params :: #srp_user{} | secret_printout(), - srp_keys ::{PublicKey :: binary(), PrivateKey :: binary()} | secret_printout(), - premaster_secret :: binary() | secret_printout() , + psk_identity :: binary() | 'undefined', % server psk identity hint + srp_params :: #srp_user{} | secret_printout() | 'undefined', + srp_keys ::{PublicKey :: binary(), PrivateKey :: binary()} | secret_printout() | 'undefined', + premaster_secret :: binary() | secret_printout() | 'undefined', file_ref_db :: db_handle(), - cert_db_ref :: certdb_ref(), + cert_db_ref :: certdb_ref() | 'undefined', bytes_to_read :: undefined | integer(), %% bytes to read in passive mode user_data_buffer :: undefined | binary() | secret_printout(), renegotiation :: undefined | {boolean(), From::term() | internal | peer}, @@ -81,7 +82,7 @@ expecting_finished = false ::boolean(), negotiated_protocol = undefined :: undefined | binary(), client_ecc, % {Curves, PointFmt} - tracker :: pid(), %% Tracker process for listen socket + tracker :: pid() | 'undefined', %% Tracker process for listen socket sni_hostname = undefined }). diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index 8c7ed9c0d1..913746598f 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -93,16 +93,16 @@ validate_extensions_fun, depth :: integer(), certfile :: binary(), - cert :: public_key:der_encoded() | secret_printout(), + cert :: public_key:der_encoded() | secret_printout() | 'undefined', keyfile :: binary(), - key :: {'RSAPrivateKey' | 'DSAPrivateKey' | 'ECPrivateKey' | 'PrivateKeyInfo', public_key:der_encoded()} | secret_printout(), - password :: string() | secret_printout(), - cacerts :: [public_key:der_encoded()] | secret_printout(), + key :: {'RSAPrivateKey' | 'DSAPrivateKey' | 'ECPrivateKey' | 'PrivateKeyInfo', public_key:der_encoded()} | secret_printout() | 'undefined', + password :: string() | secret_printout() | 'undefined', + cacerts :: [public_key:der_encoded()] | secret_printout() | 'undefined', cacertfile :: binary(), dh :: public_key:der_encoded() | secret_printout(), - dhfile :: binary() | secret_printout(), + dhfile :: binary() | secret_printout() | 'undefined', user_lookup_fun, % server option, fun to lookup the user - psk_identity :: binary() | secret_printout() , + psk_identity :: binary() | secret_printout() | 'undefined', srp_identity, % client option {User, Password} ciphers, % %% Local policy for the server if it want's to reuse the session @@ -118,7 +118,7 @@ %% undefined if not hibernating, or number of ms of %% inactivity after which ssl_connection will go into %% hibernation - hibernate_after :: boolean(), + hibernate_after :: boolean() | 'undefined', %% This option should only be set to true by inet_tls_dist erl_dist = false :: boolean(), alpn_advertised_protocols = undefined :: [binary()] | undefined , diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl index 00e95f5c5b..311dac4619 100644 --- a/lib/ssl/src/ssl_manager.erl +++ b/lib/ssl/src/ssl_manager.erl @@ -263,7 +263,9 @@ init([Name, Opts]) -> session_cache_client_max = max_session_cache_size(session_cache_client_max), session_cache_server_max = - max_session_cache_size(session_cache_server_max) + max_session_cache_size(session_cache_server_max), + session_client_invalidator = undefined, + session_server_invalidator = undefined }}. %%-------------------------------------------------------------------- @@ -378,13 +380,17 @@ handle_cast({invalidate_pem, File}, handle_info(validate_sessions, #state{session_cache_cb = CacheCb, session_cache_client = ClientCache, session_cache_server = ServerCache, - session_lifetime = LifeTime + session_lifetime = LifeTime, + session_client_invalidator = Client, + session_server_invalidator = Server } = State) -> Timer = erlang:send_after(?SESSION_VALIDATION_INTERVAL, self(), validate_sessions), - start_session_validator(ClientCache, CacheCb, LifeTime), - start_session_validator(ServerCache, CacheCb, LifeTime), - {noreply, State#state{session_validation_timer = Timer}}; + CPid = start_session_validator(ClientCache, CacheCb, LifeTime, Client), + SPid = start_session_validator(ServerCache, CacheCb, LifeTime, Server), + {noreply, State#state{session_validation_timer = Timer, + session_client_invalidator = CPid, + session_server_invalidator = SPid}}; handle_info({delayed_clean_session, Key, Cache}, #state{session_cache_cb = CacheCb @@ -471,9 +477,11 @@ validate_session(Port, Session, LifeTime) -> invalidate_session(Port, Session) end. -start_session_validator(Cache, CacheCb, LifeTime) -> +start_session_validator(Cache, CacheCb, LifeTime, undefined) -> spawn_link(?MODULE, init_session_validator, - [[get(ssl_manager), Cache, CacheCb, LifeTime]]). + [[get(ssl_manager), Cache, CacheCb, LifeTime]]); +start_session_validator(_,_,_, Pid) -> + Pid. init_session_validator([SslManagerName, Cache, CacheCb, LifeTime]) -> put(ssl_manager, SslManagerName), @@ -708,6 +716,6 @@ crl_db_info(_, UserCRLDb) -> %% Only start a session invalidator if there is not %% one already active invalidate_session_cache(undefined, CacheCb, Cache) -> - start_session_validator(Cache, CacheCb, {invalidate_before, erlang:monotonic_time()}); + start_session_validator(Cache, CacheCb, {invalidate_before, erlang:monotonic_time()}, undefined); invalidate_session_cache(Pid, _CacheCb, _Cache) -> Pid. diff --git a/lib/ssl/src/ssl_record.erl b/lib/ssl/src/ssl_record.erl index 75cfecdf5e..ce6b8fb84f 100644 --- a/lib/ssl/src/ssl_record.erl +++ b/lib/ssl/src/ssl_record.erl @@ -311,9 +311,19 @@ set_pending_cipher_state(#connection_states{pending_read = Read, %% %% Description: Encodes a handshake message to send on the ssl-socket. %%-------------------------------------------------------------------- -encode_handshake(Frag, Version, ConnectionStates) -> - encode_plain_text(?HANDSHAKE, Version, Frag, ConnectionStates). - +encode_handshake(Frag, Version, + #connection_states{current_write = + #connection_state{ + security_parameters = + #security_parameters{bulk_cipher_algorithm = BCA}}} = + ConnectionStates) -> + case iolist_size(Frag) of + N when N > ?MAX_PLAIN_TEXT_LENGTH -> + Data = split_bin(iolist_to_binary(Frag), ?MAX_PLAIN_TEXT_LENGTH, Version, BCA), + encode_iolist(?HANDSHAKE, Data, Version, ConnectionStates); + _ -> + encode_plain_text(?HANDSHAKE, Version, Frag, ConnectionStates) + end. %%-------------------------------------------------------------------- -spec encode_alert_record(#alert{}, ssl_version(), #connection_states{}) -> {iolist(), #connection_states{}}. diff --git a/lib/ssl/src/ssl_tls_dist_proxy.erl b/lib/ssl/src/ssl_tls_dist_proxy.erl index d384264b53..211badef56 100644 --- a/lib/ssl/src/ssl_tls_dist_proxy.erl +++ b/lib/ssl/src/ssl_tls_dist_proxy.erl @@ -89,6 +89,14 @@ listen_options(Opts0) -> Opts1 end. +connect_options(Opts) -> + case application:get_env(kernel, inet_dist_connect_options) of + {ok,ConnectOpts} -> + lists:ukeysort(1, ConnectOpts ++ Opts); + _ -> + Opts + end. + %%==================================================================== %% gen_server callbacks %%==================================================================== @@ -101,7 +109,7 @@ init([]) -> {ok, #state{}}. handle_call({listen, Name}, _From, State) -> - case gen_tcp:listen(0, [{active, false}, {packet,?PPRE}]) of + case gen_tcp:listen(0, [{active, false}, {packet,?PPRE}, {ip, loopback}]) of {ok, Socket} -> {ok, World} = do_listen([{active, false}, binary, {packet,?PPRE}, {reuseaddr, true}]), {ok, TcpAddress} = get_tcp_address(Socket), @@ -196,6 +204,7 @@ accept_loop(Proxy, world = Type, Listen, Extra) -> case gen_tcp:accept(Listen) of {ok, Socket} -> Opts = get_ssl_options(server), + wait_for_code_server(), case ssl:ssl_accept(Socket, Opts) of {ok, SslSocket} -> PairHandler = @@ -204,6 +213,11 @@ accept_loop(Proxy, world = Type, Listen, Extra) -> end), ok = ssl:controlling_process(SslSocket, PairHandler), flush_old_controller(PairHandler, SslSocket); + {error, {options, _}} = Error -> + %% Bad options: that's probably our fault. Let's log that. + error_logger:error_msg("Cannot accept TLS distribution connection: ~s~n", + [ssl:format_error(Error)]), + gen_tcp:close(Socket); _ -> gen_tcp:close(Socket) end; @@ -212,6 +226,35 @@ accept_loop(Proxy, world = Type, Listen, Extra) -> end, accept_loop(Proxy, Type, Listen, Extra). +wait_for_code_server() -> + %% This is an ugly hack. Upgrading a socket to TLS requires the + %% crypto module to be loaded. Loading the crypto module triggers + %% its on_load function, which calls code:priv_dir/1 to find the + %% directory where its NIF library is. However, distribution is + %% started earlier than the code server, so the code server is not + %% necessarily started yet, and code:priv_dir/1 might fail because + %% of that, if we receive an incoming connection on the + %% distribution port early enough. + %% + %% If the on_load function of a module fails, the module is + %% unloaded, and the function call that triggered loading it fails + %% with 'undef', which is rather confusing. + %% + %% Thus, the ssl_tls_dist_proxy process will terminate, and be + %% restarted by ssl_dist_sup. However, it won't have any memory + %% of being asked by net_kernel to listen for incoming + %% connections. Hence, the node will believe that it's open for + %% distribution, but it actually isn't. + %% + %% So let's avoid that by waiting for the code server to start. + case whereis(code_server) of + undefined -> + timer:sleep(10), + wait_for_code_server(); + Pid when is_pid(Pid) -> + ok + end. + try_connect(Port) -> case gen_tcp:connect({127,0,0,1}, Port, [{active, false}, {packet,?PPRE}, nodelay()]) of R = {ok, _S} -> @@ -222,10 +265,10 @@ try_connect(Port) -> setup_proxy(Ip, Port, Parent) -> process_flag(trap_exit, true), - Opts = get_ssl_options(client), + Opts = connect_options(get_ssl_options(client)), case ssl:connect(Ip, Port, [{active, true}, binary, {packet,?PPRE}, nodelay()] ++ Opts) of {ok, World} -> - {ok, ErtsL} = gen_tcp:listen(0, [{active, true}, {ip, {127,0,0,1}}, binary, {packet,?PPRE}]), + {ok, ErtsL} = gen_tcp:listen(0, [{active, true}, {ip, loopback}, binary, {packet,?PPRE}]), {ok, #net_address{address={_,LPort}}} = get_tcp_address(ErtsL), Parent ! {self(), go_ahead, LPort}, case gen_tcp:accept(ErtsL) of @@ -235,6 +278,11 @@ setup_proxy(Ip, Port, Parent) -> Err -> Parent ! {self(), Err} end; + {error, {options, _}} = Err -> + %% Bad options: that's probably our fault. Let's log that. + error_logger:error_msg("Cannot open TLS distribution connection: ~s~n", + [ssl:format_error(Err)]), + Parent ! {self(), Err}; Err -> Parent ! {self(), Err} end. diff --git a/lib/ssl/src/ssl_v3.erl b/lib/ssl/src/ssl_v3.erl index f169059a75..f98ea83771 100644 --- a/lib/ssl/src/ssl_v3.erl +++ b/lib/ssl/src/ssl_v3.erl @@ -143,9 +143,7 @@ suites() -> ?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, - ?TLS_DHE_RSA_WITH_DES_CBC_SHA, - ?TLS_RSA_WITH_DES_CBC_SHA + ?TLS_RSA_WITH_AES_128_CBC_SHA ]. %%-------------------------------------------------------------------- diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index b2b85eaf8d..c3f0206d25 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -764,6 +764,8 @@ handle_tls_handshake(Handle, StateName, case Handle(Packet, FsmReturn) of {next_state, NextStateName, State, _Timeout} -> handle_tls_handshake(Handle, NextStateName, State); + {next_state, NextStateName, State} -> + handle_tls_handshake(Handle, NextStateName, State); {stop, _,_} = Stop -> Stop end; diff --git a/lib/ssl/src/tls_v1.erl b/lib/ssl/src/tls_v1.erl index 71e5f349dd..09e378cfeb 100644 --- a/lib/ssl/src/tls_v1.erl +++ b/lib/ssl/src/tls_v1.erl @@ -208,9 +208,7 @@ suites(Minor) when Minor == 1; Minor == 2 -> ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA, ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA, ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA, - ?TLS_RSA_WITH_AES_128_CBC_SHA, - ?TLS_DHE_RSA_WITH_DES_CBC_SHA, - ?TLS_RSA_WITH_DES_CBC_SHA + ?TLS_RSA_WITH_AES_128_CBC_SHA ]; suites(3) -> [ diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile index 999df320a3..89a62c3a4b 100644 --- a/lib/ssl/test/Makefile +++ b/lib/ssl/test/Makefile @@ -81,7 +81,7 @@ HRL_FILES_NEEDED_IN_TEST = \ TARGET_FILES = $(MODULES:%=$(EBIN)/%.$(EMULATOR)) -INCLUDES = -I. -I$(ERL_TOP)/lib/test_server/include/ +INCLUDES = -I. DATADIRS = ssl_basic_SUITE_data @@ -100,8 +100,7 @@ RELSYSDIR = $(RELEASE_PATH)/ssl_test # The path to the test_server ebin dir is needed when # running the target "targets". # ---------------------------------------------------- -ERL_COMPILE_FLAGS += -pa ../../../internal_tools/test_server/ebin \ - $(INCLUDES) +ERL_COMPILE_FLAGS += $(INCLUDES) # ---------------------------------------------------- # Targets diff --git a/lib/ssl/test/erl_make_certs.erl b/lib/ssl/test/erl_make_certs.erl index 8e909a5b74..f5cada9021 100644 --- a/lib/ssl/test/erl_make_certs.erl +++ b/lib/ssl/test/erl_make_certs.erl @@ -334,7 +334,9 @@ make_key(dsa, _Opts) -> gen_dsa2(128, 20); %% Bytes i.e. {1024, 160} make_key(ec, _Opts) -> %% (OBS: for testing only) - gen_ec2(secp256k1). + CurveOid = hd(tls_v1:ecc_curves(0)), + NamedCurve = pubkey_cert_records:namedCurves(CurveOid), + gen_ec2(NamedCurve). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% RSA key generation (OBS: for testing only) diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 05b040a2ab..847a9f19de 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -121,6 +121,7 @@ options_tests() -> api_tests() -> [connection_info, + connection_information, peername, peercert, peercert_with_client_cert, @@ -182,6 +183,8 @@ cipher_tests() -> rc4_rsa_cipher_suites, rc4_ecdh_rsa_cipher_suites, rc4_ecdsa_cipher_suites, + des_rsa_cipher_suites, + des_ecdh_rsa_cipher_suites, default_reject_anonymous]. cipher_tests_ec() -> @@ -444,7 +447,7 @@ connection_info(Config) when is_list(Config) -> {from, self()}, {mfa, {?MODULE, connection_info_result, []}}, {options, - [{ciphers,[{rsa,des_cbc,sha,no_export}]} | + [{ciphers,[{rsa, aes_128_cbc, sha}]} | ClientOpts]}]), ct:log("Testcase ~p, Client ~p Server ~p ~n", @@ -453,7 +456,7 @@ connection_info(Config) when is_list(Config) -> Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), - ServerMsg = ClientMsg = {ok, {Version, {rsa, des_cbc, sha}}}, + ServerMsg = ClientMsg = {ok, {Version, {rsa, aes_128_cbc, sha}}}, ssl_test_lib:check_result(Server, ServerMsg, Client, ClientMsg), @@ -461,6 +464,37 @@ connection_info(Config) when is_list(Config) -> ssl_test_lib:close(Client). %%-------------------------------------------------------------------- + +connection_information() -> + [{doc,"Test the API function ssl:connection_information/1"}]. +connection_information(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, connection_information_result, []}}, + {options, ServerOpts}]), + + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, connection_information_result, []}}, + {options, ClientOpts}]), + + ct:log("Testcase ~p, Client ~p Server ~p ~n", + [self(), Client, Server]), + + ServerMsg = ClientMsg = ok, + + ssl_test_lib:check_result(Server, ServerMsg, Client, ClientMsg), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + + +%%-------------------------------------------------------------------- protocol_versions() -> [{doc,"Test to set a list of protocol versions in app environment."}]. @@ -1950,6 +1984,23 @@ rc4_ecdsa_cipher_suites(Config) when is_list(Config) -> Ciphers = ssl_test_lib:rc4_suites(NVersion), run_suites(Ciphers, Version, Config, rc4_ecdsa). +%%------------------------------------------------------------------- +des_rsa_cipher_suites()-> + [{doc, "Test the RC4 ciphersuites"}]. +des_rsa_cipher_suites(Config) when is_list(Config) -> + NVersion = tls_record:highest_protocol_version([]), + Version = tls_record:protocol_version(NVersion), + Ciphers = ssl_test_lib:des_suites(NVersion), + run_suites(Ciphers, Version, Config, des_rsa). +%------------------------------------------------------------------- +des_ecdh_rsa_cipher_suites()-> + [{doc, "Test the RC4 ciphersuites"}]. +des_ecdh_rsa_cipher_suites(Config) when is_list(Config) -> + NVersion = tls_record:highest_protocol_version([]), + Version = tls_record:protocol_version(NVersion), + Ciphers = ssl_test_lib:des_suites(NVersion), + run_suites(Ciphers, Version, Config, des_dhe_rsa). + %%-------------------------------------------------------------------- default_reject_anonymous()-> [{doc,"Test that by default anonymous cipher suites are rejected "}]. @@ -2686,7 +2737,12 @@ defaults(Config) when is_list(Config)-> true = lists:member(sslv3, Available), false = lists:member(sslv3, Supported), false = lists:member({rsa,rc4_128,sha}, ssl:cipher_suites()), - true = lists:member({rsa,rc4_128,sha}, ssl:cipher_suites(all)). + true = lists:member({rsa,rc4_128,sha}, ssl:cipher_suites(all)), + false = lists:member({rsa,des_cbc,sha}, ssl:cipher_suites()), + true = lists:member({rsa,des_cbc,sha}, ssl:cipher_suites(all)), + false = lists:member({dhe_rsa,des_cbc,sha}, ssl:cipher_suites()), + true = lists:member({dhe_rsa,des_cbc,sha}, ssl:cipher_suites(all)). + %%-------------------------------------------------------------------- reuseaddr() -> [{doc,"Test reuseaddr option"}]. @@ -3974,7 +4030,15 @@ run_suites(Ciphers, Version, Config, Type) -> rc4_ecdsa -> {?config(client_opts, Config), [{ciphers, Ciphers} | - ?config(server_ecdsa_opts, Config)]} + ?config(server_ecdsa_opts, Config)]}; + des_dhe_rsa -> + {?config(client_opts, Config), + [{ciphers, Ciphers} | + ?config(server_rsa_opts, Config)]}; + des_rsa -> + {?config(client_opts, Config), + [{ciphers, Ciphers} | + ?config(server_opts, Config)]} end, Result = lists:map(fun(Cipher) -> @@ -3989,7 +4053,7 @@ run_suites(Ciphers, Version, Config, Type) -> end. erlang_cipher_suite(Suite) when is_list(Suite)-> - ssl:suite_definition(ssl_cipher:openssl_suite(Suite)); + ssl_cipher:erl_suite_definition(ssl_cipher:openssl_suite(Suite)); erlang_cipher_suite(Suite) -> Suite. @@ -4010,11 +4074,11 @@ cipher(CipherSuite, Version, Config, ClientOpts, ServerOpts) -> Port = ssl_test_lib:inet_port(Server), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, - {from, self()}, - {mfa, {ssl_test_lib, cipher_result, [ConnectionInfo]}}, - {options, - [{ciphers,[CipherSuite]} | - ClientOpts]}]), + {from, self()}, + {mfa, {ssl_test_lib, cipher_result, [ConnectionInfo]}}, + {options, + [{ciphers,[CipherSuite]} | + ClientOpts]}]), Result = ssl_test_lib:wait_for_result(Server, ok, Client, ok), @@ -4028,6 +4092,17 @@ cipher(CipherSuite, Version, Config, ClientOpts, ServerOpts) -> [{ErlangCipherSuite, Error}] end. +connection_information_result(Socket) -> + {ok, Info = [_ | _]} = ssl:connection_information(Socket), + case length(Info) > 3 of + true -> + %% Atleast one ssloption() is set + ct:log("Info ~p", [Info]), + ok; + false -> + ct:fail(no_ssl_options_returned) + end. + connection_info_result(Socket) -> {ok, Info} = ssl:connection_information(Socket, [protocol, cipher_suite]), {ok, {proplists:get_value(protocol, Info), proplists:get_value(cipher_suite, Info)}}. @@ -4154,6 +4229,12 @@ first_rsa_suite([{dhe_rsa, _, _} = Suite| _]) -> Suite; first_rsa_suite([{rsa, _, _} = Suite| _]) -> Suite; +first_rsa_suite([{ecdhe_rsa, _, _, _} = Suite | _]) -> + Suite; +first_rsa_suite([{dhe_rsa, _, _, _} = Suite| _]) -> + Suite; +first_rsa_suite([{rsa, _, _, _} = Suite| _]) -> + Suite; first_rsa_suite([_ | Rest]) -> first_rsa_suite(Rest). diff --git a/lib/ssl/test/ssl_certificate_verify_SUITE.erl b/lib/ssl/test/ssl_certificate_verify_SUITE.erl index 5940a86a7f..968ef30791 100644 --- a/lib/ssl/test/ssl_certificate_verify_SUITE.erl +++ b/lib/ssl/test/ssl_certificate_verify_SUITE.erl @@ -75,7 +75,8 @@ error_handling_tests()-> unknown_server_ca_accept_verify_none, unknown_server_ca_accept_verify_peer, unknown_server_ca_accept_backwardscompatibility, - no_authority_key_identifier]. + no_authority_key_identifier, + no_authority_key_identifier_and_nonstandard_encoding]. init_per_suite(Config0) -> catch crypto:stop(), @@ -850,6 +851,68 @@ delete_authority_key_extension([Head | Rest], Acc) -> %%-------------------------------------------------------------------- +no_authority_key_identifier_and_nonstandard_encoding() -> + [{doc, "Test cert with nonstandard encoding that does not have" + " authorityKeyIdentifier extension but are present in trusted certs db."}]. + +no_authority_key_identifier_and_nonstandard_encoding(Config) when is_list(Config) -> + ClientOpts = ?config(client_verification_opts, Config), + ServerOpts = ?config(server_verification_opts, Config), + PrivDir = ?config(priv_dir, Config), + + KeyFile = filename:join(PrivDir, "otpCA/private/key.pem"), + [KeyEntry] = ssl_test_lib:pem_to_der(KeyFile), + Key = ssl_test_lib:public_key(public_key:pem_entry_decode(KeyEntry)), + + CertFile = proplists:get_value(certfile, ServerOpts), + NewCertFile = filename:join(PrivDir, "server/new_cert.pem"), + [{'Certificate', DerCert, _}] = ssl_test_lib:pem_to_der(CertFile), + ServerCert = public_key:pkix_decode_cert(DerCert, plain), + ServerTbsCert = ServerCert#'Certificate'.tbsCertificate, + Extensions0 = ServerTbsCert#'TBSCertificate'.extensions, + %% need to remove authorityKeyIdentifier extension to cause DB lookup by signature + Extensions = delete_authority_key_extension(Extensions0, []), + NewExtensions = replace_key_usage_extension(Extensions, []), + NewServerTbsCert = ServerTbsCert#'TBSCertificate'{extensions = NewExtensions}, + + ct:log("Extensions ~p~n, NewExtensions: ~p~n", [Extensions, NewExtensions]), + + TbsDer = public_key:pkix_encode('TBSCertificate', NewServerTbsCert, plain), + Sig = public_key:sign(TbsDer, md5, Key), + NewServerCert = ServerCert#'Certificate'{tbsCertificate = NewServerTbsCert, signature = Sig}, + NewDerCert = public_key:pkix_encode('Certificate', NewServerCert, plain), + ssl_test_lib:der_to_pem(NewCertFile, [{'Certificate', NewDerCert, not_encrypted}]), + NewServerOpts = [{certfile, NewCertFile} | proplists:delete(certfile, ServerOpts)], + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {ssl_test_lib, + send_recv_result_active, []}}, + {options, [{active, true} | NewServerOpts]}]), + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {ssl_test_lib, + send_recv_result_active, []}}, + {options, [{verify, verify_peer} | ClientOpts]}]), + ssl_test_lib:check_result(Server, ok, Client, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + +replace_key_usage_extension([], Acc) -> + lists:reverse(Acc); +replace_key_usage_extension([#'Extension'{extnID = ?'id-ce-keyUsage'} = E | Rest], Acc) -> + %% A nonstandard DER encoding of [digitalSignature, keyEncipherment] + Val = <<3, 2, 0, 16#A0>>, + replace_key_usage_extension(Rest, [E#'Extension'{extnValue = Val} | Acc]); +replace_key_usage_extension([Head | Rest], Acc) -> + replace_key_usage_extension(Rest, [Head | Acc]). + +%%-------------------------------------------------------------------- + invalid_signature_server() -> [{doc,"Test client with invalid signature"}]. diff --git a/lib/ssl/test/ssl_dist_SUITE.erl b/lib/ssl/test/ssl_dist_SUITE.erl index 092015d3d8..00f9ee8e3c 100644 --- a/lib/ssl/test/ssl_dist_SUITE.erl +++ b/lib/ssl/test/ssl_dist_SUITE.erl @@ -41,7 +41,7 @@ %%-------------------------------------------------------------------- all() -> [basic, payload, plain_options, plain_verify_options, nodelay_option, - listen_port_options, listen_options, use_interface]. + listen_port_options, listen_options, connect_options, use_interface]. groups() -> []. @@ -312,22 +312,7 @@ listen_port_options(Config) when is_list(Config) -> listen_options() -> [{doc, "Test inet_dist_listen_options"}]. listen_options(Config) when is_list(Config) -> - Prio = 1, - case gen_udp:open(0, [{priority,Prio}]) of - {ok,Socket} -> - case inet:getopts(Socket, [priority]) of - {ok,[{priority,Prio}]} -> - ok = gen_udp:close(Socket), - do_listen_options(Prio, Config); - _ -> - ok = gen_udp:close(Socket), - {skip, - "Can not set priority "++integer_to_list(Prio)++ - " on socket"} - end; - {error,_} -> - {skip, "Can not set priority on socket"} - end. + try_setting_priority(fun do_listen_options/2, Config). do_listen_options(Prio, Config) -> PriorityString0 = "[{priority,"++integer_to_list(Prio)++"}]", @@ -364,6 +349,48 @@ do_listen_options(Prio, Config) -> stop_ssl_node(NH2), success(Config). %%-------------------------------------------------------------------- +connect_options() -> + [{doc, "Test inet_dist_connect_options"}]. +connect_options(Config) when is_list(Config) -> + try_setting_priority(fun do_connect_options/2, Config). + +do_connect_options(Prio, Config) -> + PriorityString0 = "[{priority,"++integer_to_list(Prio)++"}]", + PriorityString = + case os:cmd("echo [{a,1}]") of + "[{a,1}]"++_ -> + PriorityString0; + _ -> + %% Some shells need quoting of [{}] + "'"++PriorityString0++"'" + end, + + Options = "-kernel inet_dist_connect_options " ++ PriorityString, + + NH1 = start_ssl_node([{additional_dist_opts, Options} | Config]), + NH2 = start_ssl_node([{additional_dist_opts, Options} | Config]), + Node2 = NH2#node_handle.nodename, + + pong = apply_on_ssl_node(NH1, fun () -> net_adm:ping(Node2) end), + + PrioritiesNode1 = + apply_on_ssl_node(NH1, fun get_socket_priorities/0), + PrioritiesNode2 = + apply_on_ssl_node(NH2, fun get_socket_priorities/0), + + Elevated1 = [P || P <- PrioritiesNode1, P =:= Prio], + ?t:format("Elevated1: ~p~n", [Elevated1]), + Elevated2 = [P || P <- PrioritiesNode2, P =:= Prio], + ?t:format("Elevated2: ~p~n", [Elevated2]), + %% Node 1 will have a socket with elevated priority. + [_|_] = Elevated1, + %% Node 2 will not, since it only applies to outbound connections. + [] = Elevated2, + + stop_ssl_node(NH1), + stop_ssl_node(NH2), + success(Config). +%%-------------------------------------------------------------------- use_interface() -> [{doc, "Test inet_dist_use_interface"}]. use_interface(Config) when is_list(Config) -> @@ -405,6 +432,24 @@ tstsrvr_format(Fmt, ArgList) -> send_to_tstcntrl(Message) -> send_to_tstsrvr({message, Message}). +try_setting_priority(TestFun, Config) -> + Prio = 1, + case gen_udp:open(0, [{priority,Prio}]) of + {ok,Socket} -> + case inet:getopts(Socket, [priority]) of + {ok,[{priority,Prio}]} -> + ok = gen_udp:close(Socket), + TestFun(Prio, Config); + _ -> + ok = gen_udp:close(Socket), + {skip, + "Can not set priority "++integer_to_list(Prio)++ + " on socket"} + end; + {error,_} -> + {skip, "Can not set priority on socket"} + end. + get_socket_priorities() -> [Priority || {ok,[{priority,Priority}]} <- @@ -493,17 +538,13 @@ host_name() -> Host. mk_node_name(Config) -> - {A, B, C} = erlang:now(), + N = erlang:unique_integer([positive]), Case = ?config(testcase, Config), atom_to_list(?MODULE) ++ "_" ++ atom_to_list(Case) ++ "_" - ++ integer_to_list(A) - ++ "-" - ++ integer_to_list(B) - ++ "-" - ++ integer_to_list(C). + ++ integer_to_list(N). mk_node_cmdline(ListenPort, Name, Args) -> Static = "-detached -noinput", @@ -732,12 +773,10 @@ rand_bin(N) -> rand_bin(0, Acc) -> Acc; rand_bin(N, Acc) -> - rand_bin(N-1, [random:uniform(256)-1|Acc]). + rand_bin(N-1, [rand:uniform(256)-1|Acc]). make_randfile(Dir) -> {ok, IoDev} = file:open(filename:join([Dir, "RAND"]), [write]), - {A, B, C} = erlang:now(), - random:seed(A, B, C), ok = file:write(IoDev, rand_bin(1024)), file:close(IoDev). diff --git a/lib/ssl/test/ssl_sni_SUITE.erl b/lib/ssl/test/ssl_sni_SUITE.erl index f6ffe91027..90c2a49e61 100644 --- a/lib/ssl/test/ssl_sni_SUITE.erl +++ b/lib/ssl/test/ssl_sni_SUITE.erl @@ -108,8 +108,12 @@ ssl_recv(SSLSocket, CurrentData, ExpectedData) -> send_and_hostname(SSLSocket) -> ssl:send(SSLSocket, "OK"), - {ok, [{sni_hostname, Hostname}]} = ssl:connection_information(SSLSocket, [sni_hostname]), - Hostname. + case ssl:connection_information(SSLSocket, [sni_hostname]) of + {ok, [{sni_hostname, Hostname}]} -> + Hostname; + {ok, []} -> + undefined + end. rdnPart([[#'AttributeTypeAndValue'{type=Type, value=Value} | _] | _], Type) -> Value; diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 9a76d603b1..b0495cb5ac 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -818,7 +818,17 @@ rsa_suites(CounterPart) -> (_) -> false end, - ssl:cipher_suites()). + common_ciphers(CounterPart)). + +common_ciphers(crypto) -> + ssl:cipher_suites(); +common_ciphers(openssl) -> + OpenSslSuites = + string:tokens(string:strip(os:cmd("openssl ciphers"), right, $\n), ":"), + [ssl_cipher:erl_suite_definition(S) + || S <- ssl_cipher:suites(tls_record:highest_protocol_version([])), + lists:member(ssl_cipher:openssl_suite_name(S), OpenSslSuites) + ]. rsa_non_signed_suites() -> lists:filter(fun({rsa, _, _}) -> @@ -971,6 +981,10 @@ rc4_suites(Version) -> Suites = ssl_cipher:rc4_suites(Version), ssl_cipher:filter_suites(Suites). +des_suites(Version) -> + Suites = ssl_cipher:des_suites(Version), + ssl_cipher:filter_suites(Suites). + pem_to_der(File) -> {ok, PemBin} = file:read_file(File), public_key:pem_decode(PemBin). @@ -1158,23 +1172,27 @@ cipher_restriction(Config0) -> end. check_sane_openssl_version(Version) -> - case {Version, os:cmd("openssl version")} of - {_, "OpenSSL 1.0.2" ++ _} -> - true; - {_, "OpenSSL 1.0.1" ++ _} -> - true; - {'tlsv1.2', "OpenSSL 1.0" ++ _} -> - false; - {'tlsv1.1', "OpenSSL 1.0" ++ _} -> - false; - {'tlsv1.2', "OpenSSL 0" ++ _} -> - false; - {'tlsv1.1', "OpenSSL 0" ++ _} -> - false; - {_, _} -> - true + case supports_ssl_tls_version(Version) of + true -> + case {Version, os:cmd("openssl version")} of + {_, "OpenSSL 1.0.2" ++ _} -> + true; + {_, "OpenSSL 1.0.1" ++ _} -> + true; + {'tlsv1.2', "OpenSSL 1.0" ++ _} -> + false; + {'tlsv1.1', "OpenSSL 1.0" ++ _} -> + false; + {'tlsv1.2', "OpenSSL 0" ++ _} -> + false; + {'tlsv1.1', "OpenSSL 0" ++ _} -> + false; + {_, _} -> + true + end; + false -> + false end. - enough_openssl_crl_support("OpenSSL 0." ++ _) -> false; enough_openssl_crl_support(_) -> true. @@ -1198,7 +1216,9 @@ version_flag('tlsv1.1') -> version_flag('tlsv1.2') -> "-tls1_2"; version_flag(sslv3) -> - "-ssl3". + "-ssl3"; +version_flag(sslv2) -> + "-ssl2". filter_suites(Ciphers0) -> Version = tls_record:highest_protocol_version([]), @@ -1208,7 +1228,7 @@ filter_suites(Ciphers0) -> ++ ssl_cipher:srp_suites() ++ ssl_cipher:rc4_suites(Version), Supported1 = ssl_cipher:filter_suites(Supported0), - Supported2 = [ssl:suite_definition(S) || S <- Supported1], + Supported2 = [ssl_cipher:erl_suite_definition(S) || S <- Supported1], [Cipher || Cipher <- Ciphers0, lists:member(Cipher, Supported2)]. -define(OPENSSL_QUIT, "Q\n"). @@ -1249,3 +1269,25 @@ portable_open_port(Exe, Args) -> ct:pal("open_port({spawn_executable, ~p}, [{args, ~p}, stderr_to_stdout]).", [AbsPath, Args]), open_port({spawn_executable, AbsPath}, [{args, Args}, stderr_to_stdout]). + +supports_ssl_tls_version(Version) -> + VersionFlag = version_flag(Version), + Exe = "openssl", + Args = ["s_client", VersionFlag], + Port = ssl_test_lib:portable_open_port(Exe, Args), + do_supports_ssl_tls_version(Port). + +do_supports_ssl_tls_version(Port) -> + receive + {Port, {data, "unknown option" ++ _}} -> + false; + {Port, {data, Data}} -> + case lists:member("error", string:tokens(Data, ":")) of + true -> + false; + false -> + do_supports_ssl_tls_version(Port) + end + after 500 -> + true + end. diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index 4441545257..6934d7f851 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -175,7 +175,12 @@ special_init(TestCase, Config) check_sane_openssl_renegotaite(Config, Version); special_init(ssl2_erlang_server_openssl_client, Config) -> - check_sane_openssl_sslv2(Config); + case ssl_test_lib:supports_ssl_tls_version(sslv2) of + true -> + Config; + false -> + {skip, "sslv2 not supported by openssl"} + end; special_init(TestCase, Config) when TestCase == erlang_client_alpn_openssl_server_alpn; @@ -754,11 +759,9 @@ erlang_server_openssl_client_client_cert(Config) when is_list(Config) -> "-CAfile", CaCertFile, "-key", KeyFile,"-connect", "localhost:" ++ integer_to_list(Port), ssl_test_lib:version_flag(Version)], - OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args), - true = port_command(OpenSslPort, Data), - + true = port_command(OpenSslPort, Data), ssl_test_lib:check_result(Server, ok), %% Clean close down! Server needs to be closed first !! @@ -842,7 +845,6 @@ erlang_client_bad_openssl_server(Config) when is_list(Config) -> Exe = "openssl", Args = ["s_server", "-accept", integer_to_list(Port), ssl_test_lib:version_flag(Version), "-cert", CertFile, "-key", KeyFile], - OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), ssl_test_lib:wait_for_openssl_server(Port), @@ -1004,7 +1006,7 @@ erlang_client_alpn_openssl_server(Config) when is_list(Config) -> Data = "From openssl to erlang", start_erlang_client_and_openssl_server_with_opts(Config, [{alpn_advertised_protocols, [<<"spdy/2">>]}], - "", + [], Data, fun(Server, OpensslPort) -> true = port_command(OpensslPort, Data), ssl_test_lib:check_result(Server, ok) @@ -1017,7 +1019,7 @@ erlang_client_openssl_server_alpn(Config) when is_list(Config) -> Data = "From openssl to erlang", start_erlang_client_and_openssl_server_with_opts(Config, [], - "-alpn spdy/2", + ["-alpn", "spdy/2"], Data, fun(Server, OpensslPort) -> true = port_command(OpensslPort, Data), ssl_test_lib:check_result(Server, ok) @@ -1154,7 +1156,7 @@ erlang_server_openssl_client_npn_renegotiate(Config) when is_list(Config) -> erlang_client_openssl_server_npn_only_server(Config) when is_list(Config) -> Data = "From openssl to erlang", start_erlang_client_and_openssl_server_with_opts(Config, [], - "-nextprotoneg spdy/2", Data, fun(Server, OpensslPort) -> + ["-nextprotoneg", "spdy/2"], Data, fun(Server, OpensslPort) -> true = port_command(OpensslPort, Data), ssl_test_lib:check_result(Server, ok) end), @@ -1166,7 +1168,7 @@ erlang_client_openssl_server_npn_only_client(Config) when is_list(Config) -> Data = "From openssl to erlang", start_erlang_client_and_openssl_server_with_opts(Config, [{client_preferred_next_protocols, - {client, [<<"spdy/2">>], <<"http/1.1">>}}], "", + {client, [<<"spdy/2">>], <<"http/1.1">>}}], [], Data, fun(Server, OpensslPort) -> true = port_command(OpensslPort, Data), ssl_test_lib:check_result(Server, ok) @@ -1266,8 +1268,12 @@ client_check_result(Port, DataExpected) -> send_and_hostname(SSLSocket) -> ssl:send(SSLSocket, "OK"), - {ok, [{sni_hostname, Hostname}]} = ssl:connection_information(SSLSocket, [sni_hostname]), - Hostname. + case ssl:connection_information(SSLSocket, [sni_hostname]) of + {ok, []} -> + undefined; + {ok, [{sni_hostname, Hostname}]} -> + Hostname + end. erlang_server_openssl_client_sni_test(Config, SNIHostname, ExpectedSNIHostname, ExpectedCN) -> ct:log("Start running handshake, Config: ~p, SNIHostname: ~p, ExpectedSNIHostname: ~p, ExpectedCN: ~p", [Config, SNIHostname, ExpectedSNIHostname, ExpectedCN]), @@ -1277,14 +1283,14 @@ erlang_server_openssl_client_sni_test(Config, SNIHostname, ExpectedSNIHostname, {from, self()}, {mfa, {?MODULE, send_and_hostname, []}}, {options, ServerOptions}]), Port = ssl_test_lib:inet_port(Server), - ClientCommand = case SNIHostname of + Exe = "openssl", + ClientArgs = case SNIHostname of undefined -> - "openssl s_client -connect " ++ Hostname ++ ":" ++ integer_to_list(Port); + ["s_client", "-connect", Hostname ++ ":" ++ integer_to_list(Port)]; _ -> - "openssl s_client -connect " ++ Hostname ++ ":" ++ integer_to_list(Port) ++ " -servername " ++ SNIHostname - end, - ct:log("Options: ~p", [[ServerOptions, ClientCommand]]), - ClientPort = open_port({spawn, ClientCommand}, [stderr_to_stdout]), + ["s_client", "-connect", Hostname ++ ":" ++ integer_to_list(Port), "-servername", SNIHostname] + end, + ClientPort = ssl_test_lib:portable_open_port(Exe, ClientArgs), %% Client check needs to be done befor server check, %% or server check might consume client messages @@ -1306,14 +1312,14 @@ erlang_server_openssl_client_sni_test_sni_fun(Config, SNIHostname, ExpectedSNIHo {from, self()}, {mfa, {?MODULE, send_and_hostname, []}}, {options, ServerOptions}]), Port = ssl_test_lib:inet_port(Server), - ClientCommand = case SNIHostname of + Exe = "openssl", + ClientArgs = case SNIHostname of undefined -> - "openssl s_client -connect " ++ Hostname ++ ":" ++ integer_to_list(Port); + ["s_client", "-connect", Hostname ++ ":" ++ integer_to_list(Port)]; _ -> - "openssl s_client -connect " ++ Hostname ++ ":" ++ integer_to_list(Port) ++ " -servername " ++ SNIHostname + ["s_client", "-connect", Hostname ++ ":" ++ integer_to_list(Port), "-servername", SNIHostname] end, - ct:log("Options: ~p", [[ServerOptions, ClientCommand]]), - ClientPort = open_port({spawn, ClientCommand}, [stderr_to_stdout]), + ClientPort = ssl_test_lib:portable_open_port(Exe, ClientArgs), %% Client check needs to be done befor server check, %% or server check might consume client messages @@ -1333,12 +1339,11 @@ cipher(CipherSuite, Version, Config, ClientOpts, ServerOpts) -> CertFile = proplists:get_value(certfile, ServerOpts), KeyFile = proplists:get_value(keyfile, ServerOpts), - Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ - " -cert " ++ CertFile ++ " -key " ++ KeyFile ++ "", - - ct:log("openssl cmd: ~p~n", [Cmd]), + Exe = "openssl", + Args = ["s_server", "-accept", integer_to_list(Port), ssl_test_lib:version_flag(Version), + "-cert", CertFile, "-key", KeyFile], - OpenSslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), + OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args), ssl_test_lib:wait_for_openssl_server(Port), @@ -1396,13 +1401,19 @@ start_erlang_client_and_openssl_server_with_opts(Config, ErlangClientOpts, Opens KeyFile = proplists:get_value(keyfile, ServerOpts), Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), - Cmd = "openssl s_server " ++ OpensslServerOpts ++ " -accept " ++ - integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ - " -cert " ++ CertFile ++ " -key " ++ KeyFile, - - ct:log("openssl cmd: ~p~n", [Cmd]), - - OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), + Exe = "openssl", + Args = case OpensslServerOpts of + [] -> + ["s_server", "-accept", + integer_to_list(Port), ssl_test_lib:version_flag(Version), + "-cert", CertFile,"-key", KeyFile]; + [Opt, Value] -> + ["s_server", Opt, Value, "-accept", + integer_to_list(Port), ssl_test_lib:version_flag(Version), + "-cert", CertFile,"-key", KeyFile] + end, + + OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), ssl_test_lib:wait_for_openssl_server(Port), @@ -1436,13 +1447,10 @@ start_erlang_client_and_openssl_server_for_alpn_negotiation(Config, Data, Callba KeyFile = proplists:get_value(keyfile, ServerOpts), Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), - Cmd = "openssl s_server -msg -alpn http/1.1,spdy/2 -accept " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ - " -cert " ++ CertFile ++ " -key " ++ KeyFile, - - ct:log("openssl cmd: ~p~n", [Cmd]), - - OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), - + Exe = "openssl", + Args = ["s_server", "-msg", "-alpn", "http/1.1,spdy/2", "-accept", integer_to_list(Port), ssl_test_lib:version_flag(Version), + "-cert", CertFile, "-key", KeyFile], + OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), ssl_test_lib:wait_for_openssl_server(Port), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, @@ -1474,12 +1482,13 @@ start_erlang_server_and_openssl_client_for_alpn_negotiation(Config, Data, Callba {options, ServerOpts}]), Port = ssl_test_lib:inet_port(Server), Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), - Cmd = "openssl s_client -alpn http/1.0,spdy/2 -msg -port " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ - " -host localhost", - ct:log("openssl cmd: ~p~n", [Cmd]), + Exe = "openssl", + Args = ["s_client", "-alpn", "http/1.0,spdy/2", "-msg", "-port", + integer_to_list(Port), ssl_test_lib:version_flag(Version), + "-host", "localhost"], - OpenSslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), + OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args), Callback(Server, OpenSslPort), @@ -1504,12 +1513,12 @@ start_erlang_client_and_openssl_server_for_alpn_npn_negotiation(Config, Data, Ca KeyFile = proplists:get_value(keyfile, ServerOpts), Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), - Cmd = "openssl s_server -msg -alpn http/1.1,spdy/2 -nextprotoneg spdy/3 -accept " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ - " -cert " ++ CertFile ++ " -key " ++ KeyFile, - - ct:log("openssl cmd: ~p~n", [Cmd]), + Exe = "openssl", + Args = ["s_server", "-msg", "-alpn", "http/1.1,spdy/2", "-nextprotoneg", + "spdy/3", "-accept", integer_to_list(Port), ssl_test_lib:version_flag(Version), + "-cert", CertFile, "-key", KeyFile], - OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), + OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), ssl_test_lib:wait_for_openssl_server(Port), @@ -1543,17 +1552,15 @@ start_erlang_server_and_openssl_client_for_alpn_npn_negotiation(Config, Data, Ca {options, ServerOpts}]), Port = ssl_test_lib:inet_port(Server), Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), - Cmd = "openssl s_client -alpn http/1.1,spdy/2 -nextprotoneg spdy/3 -msg -port " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ - " -host localhost", - - ct:log("openssl cmd: ~p~n", [Cmd]), - - OpenSslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), + Exe = "openssl", + Args = ["s_client", "-alpn", "http/1.1,spdy/2", "-nextprotoneg", "spdy/3", + "-msg", "-port", integer_to_list(Port), ssl_test_lib:version_flag(Version), + "-host", "localhost"], + OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args), Callback(Server, OpenSslPort), ssl_test_lib:close(Server), - ssl_test_lib:close_port(OpenSslPort), process_flag(trap_exit, false). @@ -1571,13 +1578,12 @@ start_erlang_client_and_openssl_server_for_npn_negotiation(Config, Data, Callbac CertFile = proplists:get_value(certfile, ServerOpts), KeyFile = proplists:get_value(keyfile, ServerOpts), Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), - - Cmd = "openssl s_server -msg -nextprotoneg http/1.1,spdy/2 -accept " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ - " -cert " ++ CertFile ++ " -key " ++ KeyFile, - - ct:log("openssl cmd: ~p~n", [Cmd]), - - OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), + + Exe = "openssl", + Args = ["s_server", "-msg", "-nextprotoneg", "http/1.1,spdy/2", "-accept", integer_to_list(Port), + ssl_test_lib:version_flag(Version), + "-cert", CertFile, "-key", KeyFile], + OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), ssl_test_lib:wait_for_openssl_server(Port), @@ -1759,30 +1765,6 @@ check_sane_openssl_renegotaite(Config) -> Config end. -check_sane_openssl_sslv2(Config) -> - Port = open_port({spawn, "openssl s_client -ssl2 "}, [stderr_to_stdout]), - case supports_sslv2(Port) of - true -> - Config; - false -> - {skip, "sslv2 not supported by openssl"} - end. - -supports_sslv2(Port) -> - receive - {Port, {data, "unknown option -ssl2" ++ _}} -> - false; - {Port, {data, Data}} -> - case lists:member("error", string:tokens(Data, ":")) of - true -> - false; - false -> - supports_sslv2(Port) - end - after 500 -> - true - end. - workaround_openssl_s_clinent() -> %% http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=683159 %% https://bugs.archlinux.org/task/33919 diff --git a/lib/ssl/test/ssl_upgrade_SUITE.erl b/lib/ssl/test/ssl_upgrade_SUITE.erl index d65bdf6983..f5f4b25b23 100644 --- a/lib/ssl/test/ssl_upgrade_SUITE.erl +++ b/lib/ssl/test/ssl_upgrade_SUITE.erl @@ -40,20 +40,19 @@ all() -> init_per_suite(Config0) -> catch crypto:stop(), - try {crypto:start(), erlang:system_info({wordsize, internal}) == erlang:system_info({wordsize, external})} of - {ok, true} -> - case ct_release_test:init(Config0) of - {skip, Reason} -> - {skip, Reason}; - Config -> - {ok, _} = make_certs:all(?config(data_dir, Config), - ?config(priv_dir, Config)), - ssl_test_lib:cert_options(Config) - end; - {ok, false} -> - {skip, "Test server will not handle halfwordemulator correctly. Skip as halfwordemulator is deprecated"} + try crypto:start() of + ok -> + case ct_release_test:init(Config0) of + {skip, Reason} -> + {skip, Reason}; + Config -> + Result = + {ok, _} = make_certs:all(?config(data_dir, Config), + ?config(priv_dir, Config)), + ssl_test_lib:cert_options(Config) + end catch _:_ -> - {skip, "Crypto did not start"} + {skip, "Crypto did not start"} end. end_per_suite(Config) -> diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk index aa1af21990..9f79a7fb34 100644 --- a/lib/ssl/vsn.mk +++ b/lib/ssl/vsn.mk @@ -1 +1 @@ -SSL_VSN = 7.2 +SSL_VSN = 7.2.1 diff --git a/lib/stdlib/doc/src/dets.xml b/lib/stdlib/doc/src/dets.xml index a0d3f95b6a..48400733d1 100644 --- a/lib/stdlib/doc/src/dets.xml +++ b/lib/stdlib/doc/src/dets.xml @@ -399,15 +399,40 @@ kept in RAM.</p> </item> <item> - <p><c>{safe_fixed,</c> SafeFixed<c>}</c>. If the table - is fixed, SafeFixed is a tuple <c>{FixedAtTime, [{Pid,RefCount}]}</c>. <c>FixedAtTime</c> is the time when + <p><c>{safe_fixed_monotonic_time, SafeFixed}</c>. If the table + is fixed, <c>SafeFixed</c> is a tuple <c>{FixedAtTime, [{Pid,RefCount}]}</c>. + <c>FixedAtTime</c> is the time when the table was first fixed, and <c>Pid</c> is the pid of the process that fixes the table <c>RefCount</c> times. There may be any number of processes in the list. If the table is not fixed, SafeFixed is the atom <c>false</c>.</p> + <p><c>FixedAtTime</c> will correspond to the result + returned by + <seealso marker="erts:erlang#monotonic_time/0">erlang:monotonic_time/0</seealso> + at the time of fixation. The usage of <c>safe_fixed_monotonic_time</c> is + <seealso marker="erts:time_correction#Time_Warp_Safe_Code">time warp + safe</seealso>.</p> </item> <item> - <p><c>{version, integer()</c>, the version of the format of + <p> + <c>{safe_fixed, SafeFixed}</c>. The same as + <c>{safe_fixed_monotonic_time, SafeFixed}</c> with the exception + of the format and value of <c>FixedAtTime</c>. + </p> + <p> + <c>FixedAtTime</c> will correspond to the result returned by + <seealso marker="erts:erlang#timestamp/0">erlang:timestamp/0</seealso> + at the time of fixation. Note that when the system is using + single or multi + <seealso marker="erts:time_correction#Time_Warp_Modes">time warp + modes</seealso> this might produce strange results. This + since the usage of <c>safe_fixed</c> is not + <seealso marker="erts:time_correction#Time_Warp_Safe_Code">time warp + safe</seealso>. Time warp safe code need to use + <c>safe_fixed_monotonic_time</c> instead.</p> + </item> + <item> + <p><c>{version, integer()}</c>, the version of the format of the table.</p> </item> </list> diff --git a/lib/stdlib/doc/src/erl_parse.xml b/lib/stdlib/doc/src/erl_parse.xml index 0938b5dec3..13be488c33 100644 --- a/lib/stdlib/doc/src/erl_parse.xml +++ b/lib/stdlib/doc/src/erl_parse.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2015</year> + <year>1996</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -44,21 +44,33 @@ </description> <datatypes> <datatype> - <name name="abstract_clause"></name> - <desc><p>Parse tree for Erlang clause.</p> + <name>abstract_clause()</name> + <desc><p><marker id="type-abstract_clause"/> + Abstract form of an Erlang clause.</p> </desc> </datatype> <datatype> - <name name="abstract_expr"></name> - <desc><p>Parse tree for Erlang expression.</p> + <name>abstract_expr()</name> + <desc><p><marker id="type-abstract_expr"/> + Abstract form of an Erlang expression.</p> </desc> </datatype> <datatype> - <name name="abstract_form"></name> - <desc><p>Parse tree for Erlang form.</p> + <name>abstract_form()</name> + <desc><p><marker id="type-abstract_form"/> + Abstract form of an Erlang form.</p> </desc> </datatype> <datatype> + <name>abstract_type()</name> + <desc><p><marker id="type-abstract_type"/> + Abstract form of an Erlang type.</p> + </desc> + </datatype> + <datatype> + <name name="erl_parse_tree"></name> + </datatype> + <datatype> <name name="error_description"></name> </datatype> <datatype> @@ -180,7 +192,7 @@ <p>Converts the Erlang data structure <c><anno>Data</anno></c> into an abstract form of type <c><anno>AbsTerm</anno></c>.</p> <p>The <c><anno>Line</anno></c> option is the line that will - be assigned to each node of the abstract form.</p> + be assigned to each node of <c><anno>AbsTerm</anno></c>.</p> <p>The <c><anno>Encoding</anno></c> option is used for selecting which integer lists will be considered as strings. The default is to use the encoding returned by @@ -196,47 +208,53 @@ <func> <name name="map_anno" arity="2"/> <fsummary> - Map a function over the annotations of an abstract form + Map a function over the annotations of a <c>erl_parse</c> tree </fsummary> <desc> - <p>Modifies the abstract form <anno>Abstr</anno> by applying - <anno>Fun</anno> on every collection of annotations of the - abstract form. The abstract form is traversed in a - depth-first, left-to-right, fashion. + <p>Modifies the <c>erl_parse</c> tree <c><anno>Abstr</anno></c> + by applying <c><anno>Fun</anno></c> on each collection of + annotations of the nodes of the <c>erl_parse</c> tree. The + <c>erl_parse</c> tree is traversed in a depth-first, + left-to-right, fashion. </p> </desc> </func> <func> <name name="fold_anno" arity="3"/> <fsummary> - Fold a function over the annotations of an abstract form + Fold a function over the annotations of a <c>erl_parse</c> tree </fsummary> <desc> - <p>Updates an accumulator by applying <anno>Fun</anno> on - every collection of annotations of the abstract form - <anno>Abstr</anno>. The first call to <anno>Fun</anno> has - <anno>AccIn</anno> as argument, and the returned accumulator - <anno>AccOut</anno> is passed to the next call, and so on. - The final value of the accumulator is returned. The abstract - form is traversed in a depth-first, left-to-right, fashion. + <p>Updates an accumulator by applying <c><anno>Fun</anno></c> on + each collection of annotations of the <c>erl_parse</c> tree + <c><anno>Abstr</anno></c>. The first call to + <c><anno>Fun</anno></c> has <c><anno>AccIn</anno></c> as + argument, and the returned accumulator + <c><anno>AccOut</anno></c> is passed to the next call, and + so on. The final value of the accumulator is returned. The + <c>erl_parse</c> tree is traversed in a depth-first, left-to-right, + fashion. </p> </desc> </func> <func> <name name="mapfold_anno" arity="3"/> <fsummary> - Map and fold a function over the annotations of an abstract form + Map and fold a function over the annotations of a + <c>erl_parse</c> tree </fsummary> <desc> - <p>Modifies the abstract form <anno>Abstr</anno> by applying - <anno>Fun</anno> on every collection of annotations of the - abstract form, while at the same time updating an - accumulator. The first call to <anno>Fun</anno> has - <anno>AccIn</anno> as second argument, and the returned - accumulator <anno>AccOut</anno> is passed to the next call, - and so on. The modified abstract form as well as the the - final value of the accumulator is returned. The abstract - form is traversed in a depth-first, left-to-right, fashion. + <p>Modifies the <c>erl_parse</c> tree <c><anno>Abstr</anno></c> + by applying <c><anno>Fun</anno></c> on each collection of + annotations of the nodes of the <c>erl_parse</c> tree, while + at the same time updating an accumulator. The first call to + <c><anno>Fun</anno></c> has <c><anno>AccIn</anno></c> as + second argument, and the returned accumulator + <c><anno>AccOut</anno></c> is passed to the next call, and + so on. The modified <c>erl_parse</c> tree as well as the the + final value of the accumulator are returned. The + <c>erl_parse</c> tree is traversed in a depth-first, + left-to-right, fashion. </p> </desc> </func> @@ -246,12 +264,15 @@ Create new annotations </fsummary> <desc> - <p>Creates an abstract form from a term which has the same - structure as an abstract form, but <seealso - marker="erl_anno#type-location">locations</seealso> where the - abstract form has annotations. For each location, <seealso - marker="erl_anno#new/1"><c>erl_anno:new/1</c></seealso> is - called, and the annotations replace the location. + <p>Assumes that <c><anno>Term</anno></c> is a term with the same + structure as a <c>erl_parse</c> tree, but with <seealso + marker="erl_anno#type-location">locations</seealso> where a + <c>erl_parse</c> tree has collections of annotations. + Returns a <c>erl_parse</c> tree where each location <c>L</c> + has been replaced by the value returned by <seealso + marker="erl_anno#new/1"><c>erl_anno:new(L)</c></seealso>. + The term <c><anno>Term</anno></c> is traversed in a + depth-first, left-to-right, fashion. </p> </desc> </func> @@ -261,12 +282,14 @@ Return annotations as terms </fsummary> <desc> - <p>Assumes that <anno>Term</anno> is a term with the same - structure as an abstract form, but with terms, T say, on - those places where an abstract form has annotations. Returns - an abstract form where every term T has been replaced by the - value returned by calling <c>erl_anno:from_term(T)</c>. The - term <anno>Term</anno> is traversed in a depth-first, + <p>Assumes that <c><anno>Term</anno></c> is a term with the same + structure as a <c>erl_parse</c> tree, but with terms, + <c>T</c> say, where a <c>erl_parse</c> tree has collections + of annotations. Returns a <c>erl_parse</c> tree where each + term <c>T</c> has been replaced by the value returned by + <seealso marker="erl_anno#from_term/1"> + <c>erl_anno:from_term(T)</c></seealso>. The term + <c><anno>Term</anno></c> is traversed in a depth-first, left-to-right, fashion. </p> </desc> @@ -277,10 +300,13 @@ Return the representation of annotations </fsummary> <desc> - <p>Returns a term where every collection of annotations Anno of - <anno>Abstr</anno> has been replaced by the term returned by - calling <c>erl_anno:to_term(Anno)</c>. The abstract form is - traversed in a depth-first, left-to-right, fashion. + <p>Returns a term where each collection of annotations + <c>Anno</c> of the nodes of the <c>erl_parse</c> tree + <c><anno>Abstr</anno></c> has been replaced by the term + returned by <seealso marker="erl_anno#to_term/1"> + <c>erl_anno:to_term(Anno)</c></seealso>. The + <c>erl_parse</c> tree is traversed in a depth-first, + left-to-right, fashion. </p> </desc> </func> diff --git a/lib/stdlib/doc/src/erl_scan.xml b/lib/stdlib/doc/src/erl_scan.xml index 342f491dd0..ee0d6b6033 100644 --- a/lib/stdlib/doc/src/erl_scan.xml +++ b/lib/stdlib/doc/src/erl_scan.xml @@ -40,39 +40,15 @@ </description> <datatypes> <datatype> - <name name="attribute_info"></name> - </datatype> - <datatype> - <name name="attributes"></name> - </datatype> - <datatype> - <name name="attributes_data"></name> - </datatype> - <datatype> <name name="category"></name> </datatype> <datatype> - <name name="column"></name> - </datatype> - <datatype> <name name="error_description"></name> </datatype> <datatype> <name name="error_info"></name> </datatype> <datatype> - <name name="info_line"></name> - </datatype> - <datatype> - <name name="info_location"></name> - </datatype> - <datatype> - <name name="line"></name> - </datatype> - <datatype> - <name name="location"></name> - </datatype> - <datatype> <name name="option"></name> </datatype> <datatype> @@ -88,9 +64,6 @@ <name name="token"></name> </datatype> <datatype> - <name name="token_info"></name> - </datatype> - <datatype> <name name="tokens"></name> </datatype> <datatype> @@ -122,25 +95,23 @@ <anno>StartLocation</anno>, [])</c>.</p> <p><c><anno>StartLocation</anno></c> indicates the initial location when scanning starts. If <c><anno>StartLocation</anno></c> is a line, - <c>attributes()</c> as well as <c><anno>EndLocation</anno></c> and + <c>Anno</c> as well as <c><anno>EndLocation</anno></c> and <c><anno>ErrorLocation</anno></c> will be lines. If <c><anno>StartLocation</anno></c> is a pair of a line and a column - <c>attributes()</c> takes the form of an opaque compound + <c>Anno</c> takes the form of an opaque compound data type, and <c><anno>EndLocation</anno></c> and <c><anno>ErrorLocation</anno></c> will be pairs of a line and a column. The <em>token - attributes</em> contain information about the column and the + annotations</em> contain information about the column and the line where the token begins, as well as the text of the token (if the <c>text</c> option is given), all of which can - be accessed by calling <seealso - marker="#token_info/1">token_info/1,2</seealso>, <seealso - marker="#attributes_info/1">attributes_info/1,2</seealso>, + be accessed by calling <seealso marker="#column/1">column/1</seealso>, <seealso marker="#line/1">line/1</seealso>, <seealso marker="#location/1">location/1</seealso>, and <seealso marker="#text/1">text/1</seealso>.</p> <p>A <em>token</em> is a tuple containing information about - syntactic category, the token attributes, and the actual + syntactic category, the token annotations, and the actual terminal symbol. For punctuation characters (e.g. <c>;</c>, <c>|</c>) and reserved words, the category and the symbol coincide, and the token is represented by a two-tuple. @@ -172,7 +143,7 @@ <item><p>Short for <c>[return_comments, return_white_spaces]</c>.</p> </item> <tag><c>text</c></tag> - <item><p>Include the token's text in the token attributes. The + <item><p>Include the token's text in the token annotation. The text is the part of the input corresponding to the token.</p> </item> </taglist> @@ -306,150 +277,6 @@ </desc> </func> <func> - <name name="token_info" arity="1"/> - <fsummary>Return information about a token</fsummary> - <desc> - <p>Returns a list containing information about the token - <c><anno>Token</anno></c>. The order of the - <c><anno>TokenInfoTuple</anno></c>s is not - defined. See <seealso - marker="#token_info/2">token_info/2</seealso> for - information about specific - <c><anno>TokenInfoTuple</anno></c>s.</p> - <p>Note that if <c>token_info(Token, TokenItem)</c> returns - <c>undefined</c> for some <c>TokenItem</c>, the - item is not included in <c><anno>TokenInfo</anno></c>.</p> - </desc> - </func> - <func> - <name name="token_info" arity="2" clause_i="1"/> - <name name="token_info" arity="2" clause_i="2"/> - <fsummary>Return information about a token</fsummary> - <type name="token_item"/> - <type name="attribute_item"/> - <desc> - <p>Returns a list containing information about the token - <c><anno>Token</anno></c>. If one single - <c><anno>TokenItem</anno></c> is given the returned value is - the corresponding - <c>TokenInfoTuple</c>, or <c>undefined</c> if the - <c>TokenItem</c> has no value. If a list of - <c><anno>TokenItem</anno></c>s is given the result is a list of - <c><anno>TokenInfoTuple</anno></c>. The - <c><anno>TokenInfoTuple</anno></c>s will - appear with the corresponding <c><anno>TokenItem</anno></c>s in - the same order as the <c><anno>TokenItem</anno></c>s - appear in the list of <c>TokenItem</c>s. - <c><anno>TokenItem</anno></c>s with no value are not included - in the list of <c><anno>TokenInfoTuple</anno></c>.</p> - <p>The following <c><anno>TokenInfoTuple</anno></c>s with corresponding - <c><anno>TokenItem</anno></c>s are valid:</p> - <taglist> - <tag><c>{category, </c><seealso marker="#type-category"> - category()</seealso><c>}</c></tag> - <item><p>The category of the token.</p> - </item> - <tag><c>{column, </c><seealso marker="#type-column"> - column()</seealso><c>}</c></tag> - <item><p>The column where the token begins.</p> - </item> - <tag><c>{length, integer() > 0}</c></tag> - <item><p>The length of the token's text.</p> - </item> - <tag><c>{line, </c><seealso marker="#type-line"> - line()</seealso><c>}</c></tag> - <item><p>The line where the token begins.</p> - </item> - <tag><c>{location, </c><seealso marker="#type-location"> - location()</seealso><c>}</c></tag> - <item><p>The line and column where the token begins, or - just the line if the column unknown.</p> - </item> - <tag><c>{symbol, </c><seealso marker="#type-symbol"> - symbol()</seealso><c>}</c></tag> - <item><p>The token's symbol.</p> - </item> - <tag><c>{text, string()}</c></tag> - <item><p>The token's text.</p> - </item> - </taglist> - </desc> - </func> - <func> - <name name="attributes_info" arity="1"/> - <fsummary>Return information about token attributes</fsummary> - <desc> - <p>Returns a list containing information about the token - attributes <c><anno>Attributes</anno></c>. The order of the - <c><anno>AttributeInfoTuple</anno></c>s is not defined. - See <seealso - marker="#attributes_info/2">attributes_info/2</seealso> for - information about specific - <c><anno>AttributeInfoTuple</anno></c>s.</p> - <p>Note that if <c>attributes_info(Token, AttributeItem)</c> - returns <c>undefined</c> for some <c>AttributeItem</c> in - the list above, the item is not included in - <c><anno>AttributesInfo</anno></c>.</p> - </desc> - </func> - <func> - <name name="attributes_info" arity="2" clause_i="1"/> - <name name="attributes_info" arity="2" clause_i="2"/> - <fsummary>Return information about a token attributes</fsummary> - <type name="attribute_item"/> - <desc> - <p>Returns a list containing information about the token - attributes <c><anno>Attributes</anno></c>. If one single - <c><anno>AttributeItem</anno></c> is given the returned value is the - corresponding <c><anno>AttributeInfoTuple</anno></c>, - or <c>undefined</c> if the <c><anno>AttributeItem</anno></c> - has no value. If a list of <c><anno>AttributeItem</anno></c> - is given the result is a list of - <c><anno>AttributeInfoTuple</anno></c>. - The <c><anno>AttributeInfoTuple</anno></c>s - will appear with the corresponding <c><anno>AttributeItem</anno></c>s - in the same order as the <c><anno>AttributeItem</anno></c>s - appear in the list of <c><anno>AttributeItem</anno></c>s. - <c><anno>AttributeItem</anno></c>s with no - value are not included in the list of - <c><anno>AttributeInfoTuple</anno></c>.</p> - <p>The following <c><anno>AttributeInfoTuple</anno></c>s with - corresponding <c><anno>AttributeItem</anno></c>s are valid:</p> - <taglist> - <tag><c>{column, </c><seealso marker="#type-column"> - column()</seealso><c>}</c></tag> - <item><p>The column where the token begins.</p> - </item> - <tag><c>{length, integer() > 0}</c></tag> - <item><p>The length of the token's text.</p> - </item> - <tag><c>{line, </c><seealso marker="#type-line"> - line()</seealso><c>}</c></tag> - <item><p>The line where the token begins.</p> - </item> - <tag><c>{location, </c><seealso marker="#type-location"> - location()</seealso><c>}</c></tag> - <item><p>The line and column where the token begins, or - just the line if the column unknown.</p> - </item> - <tag><c>{text, string()}</c></tag> - <item><p>The token's text.</p> - </item> - </taglist> - </desc> - </func> - <func> - <name name="set_attribute" arity="3"/> - <fsummary>Set a token attribute value</fsummary> - <desc> - <p>Sets the value of the <c>line</c> attribute of the token - attributes <c><anno>Attributes</anno></c>.</p> - <p>The <c><anno>SetAttributeFun</anno></c> is called with the value of - the <c>line</c> attribute, and is to return the new value of - the <c>line</c> attribute.</p> - </desc> - </func> - <func> <name name="format_error" arity="1"/> <fsummary>Format an error descriptor</fsummary> <desc> diff --git a/lib/stdlib/doc/src/ets.xml b/lib/stdlib/doc/src/ets.xml index 7b01109ff8..447fe51130 100644 --- a/lib/stdlib/doc/src/ets.xml +++ b/lib/stdlib/doc/src/ets.xml @@ -488,14 +488,39 @@ Error: fun containing local Erlang function calls <item><c>Item=fixed, Value=boolean()</c> <br></br> Indicates if the table is fixed by any process or not.</item> - <item> - <p><c>Item=safe_fixed, Value={FirstFixed,Info}|false</c> <br></br> + <item><marker id="info_2_safe_fixed_monotonic_time"/> + <p><c>Item=safe_fixed|safe_fixed_monotonic_time, Value={FixationTime,Info}|false</c> <br></br> </p> - <p>If the table has been fixed using <c>safe_fixtable/2</c>, - the call returns a tuple where <c>FirstFixed</c> is the + <p>If the table has been fixed using + <seealso marker="#safe_fixtable/2"><c>safe_fixtable/2</c></seealso>, + the call returns a tuple where <c>FixationTime</c> is the time when the table was first fixed by a process, which may or may not be one of the processes it is fixed by right now.</p> + <p>The format and value of <c>FixationTime</c> depends on + <c>Item</c>:</p> + <taglist> + <tag><c>safe_fixed</c></tag> + <item><p><c>FixationTime</c> will correspond to the result + returned by + <seealso marker="erts:erlang#timestamp/0">erlang:timestamp/0</seealso> + at the time of fixation. Note that when the system is using + single or multi + <seealso marker="erts:time_correction#Time_Warp_Modes">time warp + modes</seealso> this might produce strange results. This + since the usage of <c>safe_fixed</c> is not + <seealso marker="erts:time_correction#Time_Warp_Safe_Code">time warp + safe</seealso>. Time warp safe code need to use + <c>safe_fixed_monotonic_time</c> instead.</p></item> + + <tag><c>safe_fixed_monotonic_time</c></tag> + <item><p><c>FixationTime</c> will correspond to the result + returned by + <seealso marker="erts:erlang#monotonic_time/0">erlang:monotonic_time/0</seealso> + at the time of fixation. The usage of <c>safe_fixed_monotonic_time</c> is + <seealso marker="erts:time_correction#Time_Warp_Safe_Code">time warp + safe</seealso>.</p></item> + </taglist> <p><c>Info</c> is a possibly empty lists of tuples <c>{Pid,RefCount}</c>, one tuple for every process the table is fixed by right now. <c>RefCount</c> is the value @@ -1135,9 +1160,11 @@ clean_all_with_value(Tab,X,Key) -> table but never releases it, the memory used by the deleted objects will never be freed. The performance of operations on the table will also degrade significantly.</p> - <p>Use <c>info/2</c> to retrieve information about which - processes have fixed which tables. A system with a lot of - processes fixing tables may need a monitor which sends alarms + <p>Use + <seealso marker="#info_2_safe_fixed_monotonic_time"><c>info(Tab, + safe_fixed_monotonic_time)</c></seealso> to retrieve information + about which processes have fixed which tables. A system with a lot + of processes fixing tables may need a monitor which sends alarms when tables have been fixed for too long.</p> <p>Note that for tables of the <c>ordered_set</c> type, <c>safe_fixtable/2</c> is not necessary as calls to diff --git a/lib/stdlib/doc/src/supervisor.xml b/lib/stdlib/doc/src/supervisor.xml index 24ff251ce3..815bf4a489 100644 --- a/lib/stdlib/doc/src/supervisor.xml +++ b/lib/stdlib/doc/src/supervisor.xml @@ -543,7 +543,10 @@ </item> <item> <p><c>active</c> - the count of all actively running child processes - managed by this supervisor.</p> + managed by this supervisor. In the case of <c>simple_one_for_one</c> + supervisors, no check is carried out to ensure that each child process + is still alive, though the result provided here is likely to be very + accurate unless the supervisor is heavily overloaded.</p> </item> <item> <p><c>supervisors</c> - the count of all children marked as diff --git a/lib/stdlib/examples/erl_id_trans.erl b/lib/stdlib/examples/erl_id_trans.erl index 529ae30862..c2e345763a 100644 --- a/lib/stdlib/examples/erl_id_trans.erl +++ b/lib/stdlib/examples/erl_id_trans.erl @@ -18,11 +18,11 @@ %% -module(erl_id_trans). -%% A identity transformer of Erlang abstract syntax. +%% An identity transformer of Erlang abstract syntax. %% This module only traverses legal Erlang code. This is most noticeable %% in guards where only a limited number of expressions are allowed. -%% N.B. if this module is to be used as a basis for tranforms then +%% N.B. if this module is to be used as a basis for transforms then %% all the error cases must be handled otherwise this module just crashes! -export([parse_transform/2]). @@ -53,6 +53,17 @@ form({attribute,Line,export,Es0}) -> form({attribute,Line,import,{Mod,Is0}}) -> Is1 = farity_list(Is0), {attribute,Line,import,{Mod,Is1}}; +form({attribute,Line,export_type,Es0}) -> + Es1 = farity_list(Es0), + {attribute,Line,export_type,Es1}; +form({attribute,Line,optional_callbacks,Es0}) -> + try farity_list(Es0) of + Es1 -> + {attribute,Line,optional_callbacks,Es1} + catch + _:_ -> + {attribute,Line,optional_callbacks,Es0} + end; form({attribute,Line,compile,C}) -> {attribute,Line,compile,C}; form({attribute,Line,record,{Name,Defs0}}) -> @@ -60,14 +71,28 @@ form({attribute,Line,record,{Name,Defs0}}) -> {attribute,Line,record,{Name,Defs1}}; form({attribute,Line,asm,{function,N,A,Code}}) -> {attribute,Line,asm,{function,N,A,Code}}; +form({attribute,Line,type,{N,T,Vs}}) -> + T1 = type(T), + Vs1 = variable_list(Vs), + {attribute,Line,type,{N,T1,Vs1}}; +form({attribute,Line,opaque,{N,T,Vs}}) -> + T1 = type(T), + Vs1 = variable_list(Vs), + {attribute,Line,opaque,{N,T1,Vs1}}; +form({attribute,Line,spec,{{N,A},FTs}}) -> + FTs1 = function_type_list(FTs), + {attribute,Line,spec,{{N,A},FTs1}}; +form({attribute,Line,spec,{{M,N,A},FTs}}) -> + FTs1 = function_type_list(FTs), + {attribute,Line,spec,{{M,N,A},FTs1}}; +form({attribute,Line,callback,{{N,A},FTs}}) -> + FTs1 = function_type_list(FTs), + {attribute,Line,callback,{{N,A},FTs1}}; form({attribute,Line,Attr,Val}) -> %The general attribute. {attribute,Line,Attr,Val}; form({function,Line,Name0,Arity0,Clauses0}) -> {Name,Arity,Clauses} = function(Name0, Arity0, Clauses0), {function,Line,Name,Arity,Clauses}; -% Mnemosyne, ignore... -form({rule,Line,Name,Arity,Body}) -> - {rule,Line,Name,Arity,Body}; % Dont dig into this %% Extra forms from the parser. form({error,E}) -> {error,E}; form({warning,W}) -> {warning,W}; @@ -79,6 +104,12 @@ farity_list([{Name,Arity}|Fas]) -> [{Name,Arity}|farity_list(Fas)]; farity_list([]) -> []. +%% -type variable_list([Var]) -> [Var] + +variable_list([{var,Line,Var}|Vs]) -> + [{var,Line,Var}|variable_list(Vs)]; +variable_list([]) -> []. + %% -type record_defs([RecDef]) -> [RecDef]. %% N.B. Field names are full expressions here but only atoms are allowed %% by the *parser*! @@ -88,6 +119,16 @@ record_defs([{record_field,Line,{atom,La,A},Val0}|Is]) -> [{record_field,Line,{atom,La,A},Val1}|record_defs(Is)]; record_defs([{record_field,Line,{atom,La,A}}|Is]) -> [{record_field,Line,{atom,La,A}}|record_defs(Is)]; +record_defs([{typed_record_field,{record_field,Line,{atom,La,A},Val0},Type}| + Is]) -> + Val1 = expr(Val0), + Type1 = type(Type), + [{typed_record_field,{record_field,Line,{atom,La,A},Val1},Type1}| + record_defs(Is)]; +record_defs([{typed_record_field,{record_field,Line,{atom,La,A}},Type}|Is]) -> + Type1 = type(Type), + [{typed_record_field,{record_field,Line,{atom,La,A}},Type1}| + record_defs(Is)]; record_defs([]) -> []. %% -type function(atom(), integer(), [Clause]) -> {atom(),integer(),[Clause]}. @@ -196,9 +237,9 @@ pattern_grp([]) -> bit_types([]) -> []; -bit_types([Atom | Rest]) when atom(Atom) -> +bit_types([Atom | Rest]) when is_atom(Atom) -> [Atom | bit_types(Rest)]; -bit_types([{Atom, Integer} | Rest]) when atom(Atom), integer(Integer) -> +bit_types([{Atom, Integer} | Rest]) when is_atom(Atom), is_integer(Integer) -> [{Atom, Integer} | bit_types(Rest)]. @@ -226,7 +267,7 @@ pattern_fields([]) -> []. %% -type guard([GuardTest]) -> [GuardTest]. -guard([G0|Gs]) when list(G0) -> +guard([G0|Gs]) when is_list(G0) -> [guard0(G0) | guard(Gs)]; guard(L) -> guard0(L). @@ -547,3 +588,97 @@ fun_clauses([C0|Cs]) -> C1 = clause(C0), [C1|fun_clauses(Cs)]; fun_clauses([]) -> []. + +function_type_list([{type,Line,bounded_fun,[Ft,Fc]}|Fts]) -> + Ft1 = function_type(Ft), + Fc1 = function_constraint(Fc), + [{type,Line,bounded_fun,[Ft1,Fc1]}|function_type_list(Fts)]; +function_type_list([Ft|Fts]) -> + [function_type(Ft)|function_type_list(Fts)]; +function_type_list([]) -> []. + +function_type({type,Line,'fun',[{type,Lt,product,As},B]}) -> + As1 = type_list(As), + B1 = type(B), + {type,Line,'fun',[{type,Lt,product,As1},B1]}. + +function_constraint([C|Cs]) -> + C1 = constraint(C), + [C1|function_constraint(Cs)]; +function_constraint([]) -> []. + +constraint({type,Line,constraint,[{atom,L,A},[V,T]]}) -> + V1 = type(V), + T1 = type(T), + {type,Line,constraint,[{atom,L,A},[V1,T1]]}. + +type({ann_type,Line,[{var,Lv,V},T]}) -> + T1 = type(T), + {ann_type,Line,[{var,Lv,V},T1]}; +type({atom,Line,A}) -> + {atom,Line,A}; +type({integer,Line,I}) -> + {integer,Line,I}; +type({op,Line,Op,T}) -> + T1 = type(T), + {op,Line,Op,T1}; +type({op,Line,Op,L,R}) -> + L1 = type(L), + R1 = type(R), + {op,Line,Op,L1,R1}; +type({type,Line,binary,[M,N]}) -> + M1 = type(M), + N1 = type(N), + {type,Line,binary,[M1,N1]}; +type({type,Line,'fun',[]}) -> + {type,Line,'fun',[]}; +type({type,Line,'fun',[{type,Lt,any},B]}) -> + B1 = type(B), + {type,Line,'fun',[{type,Lt,any},B1]}; +type({type,Line,range,[L,H]}) -> + L1 = type(L), + H1 = type(H), + {type,Line,range,[L1,H1]}; +type({type,Line,map,any}) -> + {type,Line,map,any}; +type({type,Line,map,Ps}) -> + Ps1 = map_pair_types(Ps), + {type,Line,map,Ps1}; +type({type,Line,record,[{atom,La,N}|Fs]}) -> + Fs1 = field_types(Fs), + {type,Line,record,[{atom,La,N}|Fs1]}; +type({remote_type,Line,[{atom,Lm,M},{atom,Ln,N},As]}) -> + As1 = type_list(As), + {remote_type,Line,[{atom,Lm,M},{atom,Ln,N},As1]}; +type({type,Line,tuple,any}) -> + {type,Line,tuple,any}; +type({type,Line,tuple,Ts}) -> + Ts1 = type_list(Ts), + {type,Line,tuple,Ts1}; +type({type,Line,union,Ts}) -> + Ts1 = type_list(Ts), + {type,Line,union,Ts1}; +type({var,Line,V}) -> + {var,Line,V}; +type({user_type,Line,N,As}) -> + As1 = type_list(As), + {user_type,Line,N,As1}; +type({type,Line,N,As}) -> + As1 = type_list(As), + {type,Line,N,As1}. + +map_pair_types([{type,Line,map_field_assoc,[K,V]}|Ps]) -> + K1 = type(K), + V1 = type(V), + [{type,Line,map_field_assoc,[K1,V1]}|map_pair_types(Ps)]; +map_pair_types([]) -> []. + +field_types([{type,Line,field_type,[{atom,La,A},T]}|Fs]) -> + T1 = type(T), + [{type,Line,field_type,[{atom,La,A},T1]}|field_types(Fs)]; +field_types([]) -> []. + +type_list([T|Ts]) -> + T1 = type(T), + [T1|type_list(Ts)]; +type_list([]) -> []. diff --git a/lib/stdlib/include/erl_bits.hrl b/lib/stdlib/include/erl_bits.hrl index 8405a55d55..2a54587a17 100644 --- a/lib/stdlib/include/erl_bits.hrl +++ b/lib/stdlib/include/erl_bits.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2015. 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. @@ -26,10 +26,10 @@ -type bt_unit() :: 1..256. -record(bittype, { - type :: bt_type(), - unit :: bt_unit(), %% element unit - sign :: bt_sign(), - endian :: bt_endian() + type :: bt_type() | 'undefined', + unit :: bt_unit() | 'undefined', %% element unit + sign :: bt_sign() | 'undefined', + endian :: bt_endian() | 'undefined' }). -record(bitdefault, { diff --git a/lib/stdlib/src/beam_lib.erl b/lib/stdlib/src/beam_lib.erl index cbbab088f4..7a17226e46 100644 --- a/lib/stdlib/src/beam_lib.erl +++ b/lib/stdlib/src/beam_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2015. All Rights Reserved. +%% 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. @@ -872,7 +872,7 @@ mandatory_chunks() -> %%% can use it. %%% ==================================================================== --record(state, {crypto_key_f :: crypto_fun()}). +-record(state, {crypto_key_f :: crypto_fun() | 'undefined'}). -define(CRYPTO_KEY_SERVER, beam_lib__crypto_key_server). @@ -904,7 +904,11 @@ anno_from_term({Tag, Forms}) when Tag =:= abstract_v1; Tag =:= abstract_v2 -> anno_from_term(T) -> T. -anno_from_forms(Forms) -> +anno_from_forms(Forms0) -> + %% Forms with record field types created before OTP 19.0 are + %% replaced by well-formed record forms holding the type + %% information. + Forms = epp:restore_typed_record_fields(Forms0), [erl_parse:anno_from_term(Form) || Form <- Forms]. start_crypto() -> @@ -931,7 +935,10 @@ call_crypto_server(Req) -> end. call_crypto_server_1(Req) -> - {ok, _} = gen_server:start({local,?CRYPTO_KEY_SERVER}, ?MODULE, [], []), + case gen_server:start({local,?CRYPTO_KEY_SERVER}, ?MODULE, [], []) of + {ok, _} -> ok; + {error, {already_started, _}} -> ok + end, erlang:yield(), call_crypto_server(Req). @@ -972,9 +979,7 @@ handle_call({get_crypto_key, What}, From, #state{crypto_key_f=F}=S) -> handle_call({crypto_key_fun, F}, {_,_} = From, S) -> case S#state.crypto_key_f of undefined -> - %% Don't allow tuple funs here. (They weren't allowed before, - %% so there is no reason to allow them now.) - if is_function(F), is_function(F, 1) -> + if is_function(F, 1) -> {Result, Fun, Reply} = case catch F(init) of ok -> diff --git a/lib/stdlib/src/binary.erl b/lib/stdlib/src/binary.erl index af00410572..fb0c395d70 100644 --- a/lib/stdlib/src/binary.erl +++ b/lib/stdlib/src/binary.erl @@ -20,7 +20,7 @@ -module(binary). %% %% Implemented in this module: --export([split/2,split/3,replace/3,replace/4]). +-export([replace/3,replace/4]). -export_type([cp/0]). @@ -34,7 +34,8 @@ decode_unsigned/2, encode_unsigned/1, encode_unsigned/2, first/1, last/1, list_to_bin/1, longest_common_prefix/1, longest_common_suffix/1, match/2, match/3, matches/2, - matches/3, part/2, part/3, referenced_byte_size/1]). + matches/3, part/2, part/3, referenced_byte_size/1, + split/2, split/3]). -spec at(Subject, Pos) -> byte() when Subject :: binary(), @@ -198,19 +199,13 @@ part(_, _, _) -> referenced_byte_size(_) -> erlang:nif_error(undef). -%%% End of BIFs. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% split -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -spec split(Subject, Pattern) -> Parts when Subject :: binary(), Pattern :: binary() | [binary()] | cp(), Parts :: [binary()]. -split(H,N) -> - split(H,N,[]). +split(_, _) -> + erlang:nif_error(undef). -spec split(Subject, Pattern, Options) -> Parts when Subject :: binary(), @@ -219,53 +214,10 @@ split(H,N) -> Option :: {scope, part()} | trim | global | trim_all, Parts :: [binary()]. -split(Haystack,Needles,Options) -> - try - {Part,Global,Trim,TrimAll} = - get_opts_split(Options,{no,false,false,false}), - Moptlist = case Part of - no -> - []; - {A,B} -> - [{scope,{A,B}}] - end, - MList = if - Global -> - binary:matches(Haystack,Needles,Moptlist); - true -> - case binary:match(Haystack,Needles,Moptlist) of - nomatch -> []; - Match -> [Match] - end - end, - do_split(Haystack,MList,0,Trim,TrimAll) - catch - _:_ -> - erlang:error(badarg) - end. - -do_split(H,[],N,true,_) when N >= byte_size(H) -> - []; -do_split(H,[],N,_,true) when N >= byte_size(H) -> - []; -do_split(H,[],N,_,_) -> - [binary:part(H,{N,byte_size(H)-N})]; -do_split(H,[{A,B}|T],N,Trim,TrimAll) -> - case binary:part(H,{N,A-N}) of - <<>> when TrimAll == true -> - do_split(H,T,A+B,Trim,TrimAll); - <<>> -> - Rest = do_split(H,T,A+B,Trim,TrimAll), - case {Trim, Rest} of - {true,[]} -> - []; - _ -> - [<<>> | Rest] - end; - Oth -> - [Oth | do_split(H,T,A+B,Trim,TrimAll)] - end. +split(_, _, _) -> + erlang:nif_error(undef). +%%% End of BIFs. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% replace @@ -352,19 +304,6 @@ splitat(H,N,[I|T]) -> %% Simple helper functions %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -get_opts_split([],{Part,Global,Trim,TrimAll}) -> - {Part,Global,Trim,TrimAll}; -get_opts_split([{scope,{A,B}} | T],{_Part,Global,Trim,TrimAll}) -> - get_opts_split(T,{{A,B},Global,Trim,TrimAll}); -get_opts_split([global | T],{Part,_Global,Trim,TrimAll}) -> - get_opts_split(T,{Part,true,Trim,TrimAll}); -get_opts_split([trim | T],{Part,Global,_Trim,TrimAll}) -> - get_opts_split(T,{Part,Global,true,TrimAll}); -get_opts_split([trim_all | T],{Part,Global,Trim,_TrimAll}) -> - get_opts_split(T,{Part,Global,Trim,true}); -get_opts_split(_,_) -> - throw(badopt). - get_opts_replace([],{Part,Global,Insert}) -> {Part,Global,Insert}; get_opts_replace([{scope,{A,B}} | T],{_Part,Global,Insert}) -> diff --git a/lib/stdlib/src/dets.erl b/lib/stdlib/src/dets.erl index 6d07f4018a..bf22949870 100644 --- a/lib/stdlib/src/dets.erl +++ b/lib/stdlib/src/dets.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. 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. @@ -372,7 +372,7 @@ info(Tab) -> Item :: 'access' | 'auto_save' | 'bchunk_format' | 'hash' | 'file_size' | 'filename' | 'keypos' | 'memory' | 'no_keys' | 'no_objects' | 'no_slots' | 'owner' | 'ram_file' - | 'safe_fixed' | 'size' | 'type' | 'version', + | 'safe_fixed' | 'safe_fixed_monotonic_time' | 'size' | 'type' | 'version', Value :: term(). info(Tab, owner) -> @@ -1124,7 +1124,9 @@ repl({delayed_write, {Delay,Size} = C}, Defs) Defs#open_args{delayed_write = C}; repl({estimated_no_objects, I}, Defs) -> repl({min_no_slots, I}, Defs); -repl({file, File}, Defs) -> +repl({file, File}, Defs) when is_list(File) -> + Defs#open_args{file = File}; +repl({file, File}, Defs) when is_atom(File) -> Defs#open_args{file = to_list(File)}; repl({keypos, P}, Defs) when is_integer(P), P > 0 -> Defs#open_args{keypos =P}; @@ -1289,7 +1291,15 @@ init(Parent, Server) -> open_file_loop(#head{parent = Parent, server = Server}). open_file_loop(Head) -> - open_file_loop(Head, 0). + %% The Dets server pretends the file is open before + %% internal_open() has been called, which means that unless the + %% internal_open message is applied first, other processes can + %% find the pid by calling dets_server:get_pid() and do things + %% before Head has been initialized properly. + receive + ?DETS_CALL(From, {internal_open, _Ref, _Args}=Op) -> + do_apply_op(Op, From, Head, 0) + end. open_file_loop(Head, N) when element(1, Head#head.update_mode) =:= error -> open_file_loop2(Head, N); @@ -1964,7 +1974,9 @@ do_safe_fixtable(Head, Pid, true) -> case Head#head.fixed of false -> link(Pid), - Fixed = {utime_now(), [{Pid, 1}]}, + MonTime = erlang:monotonic_time(), + TimeOffset = erlang:time_offset(), + Fixed = {{MonTime, TimeOffset}, [{Pid, 1}]}, Ftab = dets_utils:get_freelists(Head), Head#head{fixed = Fixed, freelists = {Ftab, Ftab}}; {TimeStamp, Counters} -> @@ -2091,7 +2103,22 @@ finfo(H, no_keys) -> finfo(H, no_slots) -> {H, (H#head.mod):no_slots(H)}; finfo(H, pid) -> {H, self()}; finfo(H, ram_file) -> {H, H#head.ram_file}; -finfo(H, safe_fixed) -> {H, H#head.fixed}; +finfo(H, safe_fixed) -> + {H, + case H#head.fixed of + false -> + false; + {{FixMonTime, TimeOffset}, RefList} -> + {make_timestamp(FixMonTime, TimeOffset), RefList} + end}; +finfo(H, safe_fixed_monotonic_time) -> + {H, + case H#head.fixed of + false -> + false; + {{FixMonTime, _TimeOffset}, RefList} -> + {FixMonTime, RefList} + end}; finfo(H, size) -> case catch write_cache(H) of {H2, []} -> @@ -3275,11 +3302,14 @@ err(Error) -> time_now() -> erlang:monotonic_time(1000000). --compile({inline, [utime_now/0]}). -utime_now() -> - Time = time_now(), - UniqueCounter = erlang:unique_integer([monotonic]), - {Time, UniqueCounter}. +make_timestamp(MonTime, TimeOffset) -> + ErlangSystemTime = erlang:convert_time_unit(MonTime+TimeOffset, + native, + micro_seconds), + MegaSecs = ErlangSystemTime div 1000000000000, + Secs = ErlangSystemTime div 1000000 - MegaSecs*1000000, + MicroSecs = ErlangSystemTime rem 1000000, + {MegaSecs, Secs, MicroSecs}. %%%%%%%%%%%%%%%%% DEBUG functions %%%%%%%%%%%%%%%% diff --git a/lib/stdlib/src/dets_utils.erl b/lib/stdlib/src/dets_utils.erl index 196158cd48..34a8ddddaa 100644 --- a/lib/stdlib/src/dets_utils.erl +++ b/lib/stdlib/src/dets_utils.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2013. All Rights Reserved. +%% 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. @@ -747,6 +747,8 @@ all_allocated([{X,Y} | L], _X0, Y0, A) when Y0 < X -> all_allocated_as_list(Head) -> all_allocated_as_list(all(get_freelists(Head)), 0, Head#head.base, []). +-dialyzer({no_improper_lists, all_allocated_as_list/4}). + all_allocated_as_list([], _X0, _Y0, []) -> []; all_allocated_as_list([], _X0, _Y0, A) -> diff --git a/lib/stdlib/src/dets_v8.erl b/lib/stdlib/src/dets_v8.erl index 49126193b8..1bf53d91b1 100644 --- a/lib/stdlib/src/dets_v8.erl +++ b/lib/stdlib/src/dets_v8.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2013. All Rights Reserved. +%% 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. @@ -36,6 +36,8 @@ %% For backward compatibility. -export([sz2pos/1]). +-dialyzer(no_improper_lists). + -compile({inline, [{sz2pos,1},{scan_skip,7}]}). -compile({inline, [{skip_bytes,5}, {get_segp,1}]}). -compile({inline, [{wl_lookup,5}]}). diff --git a/lib/stdlib/src/dets_v9.erl b/lib/stdlib/src/dets_v9.erl index 361780c776..6c406fc03a 100644 --- a/lib/stdlib/src/dets_v9.erl +++ b/lib/stdlib/src/dets_v9.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2013. All Rights Reserved. +%% 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. @@ -34,6 +34,8 @@ -export([cache_segps/3]). +-dialyzer(no_improper_lists). + -compile({inline, [{max_objsize,1},{maxobjsize,1}]}). -compile({inline, [{write_segment_file,6}]}). -compile({inline, [{sz2pos,1},{adjsz,1}]}). diff --git a/lib/stdlib/src/dict.erl b/lib/stdlib/src/dict.erl index 6ce3710f87..f921e28ef6 100644 --- a/lib/stdlib/src/dict.erl +++ b/lib/stdlib/src/dict.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2014. All Rights Reserved. +%% 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. @@ -333,6 +333,8 @@ update_counter(Key, Incr, D0) when is_number(Incr) -> D0, Slot), maybe_expand(D1, Ic). +-dialyzer({no_improper_lists, counter_bkt/3}). + counter_bkt(Key, I, [?kv(Key,Val)|Bkt]) -> {[?kv(Key,Val+I)|Bkt],0}; counter_bkt(Key, I, [Other|Bkt0]) -> diff --git a/lib/stdlib/src/digraph.erl b/lib/stdlib/src/digraph.erl index e51e560542..8a4df95027 100644 --- a/lib/stdlib/src/digraph.erl +++ b/lib/stdlib/src/digraph.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. 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. @@ -338,6 +338,8 @@ edge(G, E) -> %% -spec new_edge_id(graph()) -> edge(). +-dialyzer({no_improper_lists, new_edge_id/1}). + new_edge_id(G) -> NT = G#digraph.ntab, [{'$eid', K}] = ets:lookup(NT, '$eid'), @@ -350,6 +352,8 @@ new_edge_id(G) -> %% -spec new_vertex_id(graph()) -> vertex(). +-dialyzer({no_improper_lists, new_vertex_id/1}). + new_vertex_id(G) -> NT = G#digraph.ntab, [{'$vid', K}] = ets:lookup(NT, '$vid'), diff --git a/lib/stdlib/src/edlin.erl b/lib/stdlib/src/edlin.erl index 19444c0502..0e9c457de2 100644 --- a/lib/stdlib/src/edlin.erl +++ b/lib/stdlib/src/edlin.erl @@ -465,7 +465,6 @@ word_char(C) when C >= $a, C =< $z -> true; word_char(C) when C >= $ß, C =< $ÿ, C =/= $÷ -> true; word_char(C) when C >= $0, C =< $9 -> true; word_char(C) when C =:= $_ -> true; -word_char(C) when C =:= $. -> true; % accept dot-separated names word_char(_) -> false. %% over_white(Chars, InitialStack, InitialCount) -> diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl index d3124ac593..936c095aef 100644 --- a/lib/stdlib/src/epp.erl +++ b/lib/stdlib/src/epp.erl @@ -40,16 +40,21 @@ -type ifdef() :: 'ifdef' | 'ifndef' | 'else'. --type name() :: {'atom', atom()}. +-type name() :: atom(). -type argspec() :: 'none' %No arguments | non_neg_integer(). %Number of arguments -type tokens() :: [erl_scan:token()]. -type used() :: {name(), argspec()}. +-type function_name_type() :: 'undefined' + | {atom(),non_neg_integer()} + | tokens(). + -define(DEFAULT_ENCODING, utf8). %% Epp state record. --record(epp, {file :: file:io_device(), %Current file +-record(epp, {file :: file:io_device() + | 'undefined', %Current file location=1, %Current location delta=0 :: non_neg_integer(), %Offset from Location (-file) name="" :: file:name(), %Current file name @@ -57,21 +62,15 @@ istk=[] :: [ifdef()], %Ifdef stack sstk=[] :: [#epp{}], %State stack path=[] :: [file:name()], %Include-path - macs = dict:new() %Macros (don't care locations) - :: dict:dict(name(), {argspec(), tokens()}), - uses = dict:new() %Macro use structure - :: dict:dict(name(), [{argspec(), [used()]}]), + macs = #{} %Macros (don't care locations) + :: #{name() => {argspec(), tokens()}}, + uses = #{} %Macro use structure + :: #{name() => [{argspec(), [used()]}]}, default_encoding = ?DEFAULT_ENCODING :: source_encoding(), - pre_opened = false :: boolean() + pre_opened = false :: boolean(), + fname = [] :: function_name_type() }). -%%% Note on representation: as tokens, both {var, Location, Name} and -%%% {atom, Location, Name} can occur as macro identifiers. However, keeping -%%% this distinction here is done for historical reasons only: previously, -%%% ?FOO and ?'FOO' were not the same, but now they are. Removing the -%%% distinction in the internal representation would simplify the code -%%% a little. - %% open(Options) %% open(FileName, IncludePath) %% open(FileName, IncludePath, PreDefMacros) @@ -211,6 +210,10 @@ format_error({include,W,F}) -> io_lib:format("can't find include ~s \"~s\"", [W,F]); format_error({illegal,How,What}) -> io_lib:format("~s '-~s'", [How,What]); +format_error({illegal_function,Macro}) -> + io_lib:format("?~s can only be used within a function", [Macro]); +format_error({illegal_function_usage,Macro}) -> + io_lib:format("?~s must not begin a form", [Macro]); format_error({'NYI',What}) -> io_lib:format("not yet implemented '~s'", [What]); format_error(E) -> file:format_error(E). @@ -264,20 +267,7 @@ parse_file(Ifile, Options) -> parse_file(Epp) -> case parse_erl_form(Epp) of {ok,Form} -> - case Form of - {attribute,La,record,{Record, Fields}} -> - case normalize_typed_record_fields(Fields) of - {typed, NewFields} -> - [{attribute, La, record, {Record, NewFields}}, - {attribute, La, type, - {{record, Record}, Fields, []}} - |parse_file(Epp)]; - not_typed -> - [Form|parse_file(Epp)] - end; - _ -> - [Form|parse_file(Epp)] - end; + [Form|parse_file(Epp)]; {error,E} -> [{error,E}|parse_file(Epp)]; {eof,Location} -> @@ -549,7 +539,8 @@ init_server(Pid, Name, Options, St0) -> default_encoding=DefEncoding}, From = wait_request(St), Anno = erl_anno:new(AtLocation), - enter_file_reply(From, Name, Anno, AtLocation, code), + enter_file_reply(From, file_name(Name), Anno, + AtLocation, code), wait_req_scan(St); {error,E} -> epp_reply(Pid, {error,E}) @@ -560,18 +551,20 @@ init_server(Pid, Name, Options, St0) -> %% FILE, LINE, MODULE as undefined, MACHINE and MACHINE value. predef_macros(File) -> - Machine = list_to_atom(erlang:system_info(machine)), - Anno = line1(), - dict:from_list([ - {{atom,'FILE'}, {none,[{string,Anno,File}]}}, - {{atom,'LINE'}, {none,[{integer,Anno,1}]}}, - {{atom,'MODULE'}, undefined}, - {{atom,'MODULE_STRING'}, undefined}, - {{atom,'BASE_MODULE'}, undefined}, - {{atom,'BASE_MODULE_STRING'}, undefined}, - {{atom,'MACHINE'}, {none,[{atom,Anno,Machine}]}}, - {{atom,Machine}, {none,[{atom,Anno,true}]}} - ]). + Machine = list_to_atom(erlang:system_info(machine)), + Anno = line1(), + Defs = [{'FILE', {none,[{string,Anno,File}]}}, + {'FUNCTION_NAME', undefined}, + {'FUNCTION_ARITY', undefined}, + {'LINE', {none,[{integer,Anno,1}]}}, + {'MODULE', undefined}, + {'MODULE_STRING', undefined}, + {'BASE_MODULE', undefined}, + {'BASE_MODULE_STRING', undefined}, + {'MACHINE', {none,[{atom,Anno,Machine}]}}, + {Machine, {none,[{atom,Anno,true}]}} + ], + maps:from_list(Defs). %% user_predef(PreDefMacros, Macros) -> %% {ok,MacroDict} | {error,E} @@ -580,28 +573,21 @@ predef_macros(File) -> user_predef([{M,Val,redefine}|Pdm], Ms) when is_atom(M) -> Exp = erl_parse:tokens(erl_parse:abstract(Val)), - user_predef(Pdm, dict:store({atom,M}, {none,Exp}, Ms)); + user_predef(Pdm, Ms#{M=>{none,Exp}}); user_predef([{M,Val}|Pdm], Ms) when is_atom(M) -> - case dict:find({atom,M}, Ms) of - {ok,_Defs} when is_list(_Defs) -> %% User defined macros + case Ms of + #{M:=Defs} when is_list(Defs) -> + %% User defined macros. {error,{redefine,M}}; - {ok,_Def} -> %% Predefined macros + #{M:=_Defs} -> + %% Predefined macros. {error,{redefine_predef,M}}; - error -> + _ -> Exp = erl_parse:tokens(erl_parse:abstract(Val)), - user_predef(Pdm, dict:store({atom,M}, [{none, {none,Exp}}], Ms)) + user_predef(Pdm, Ms#{M=>[{none,{none,Exp}}]}) end; user_predef([M|Pdm], Ms) when is_atom(M) -> - case dict:find({atom,M}, Ms) of - {ok,_Defs} when is_list(_Defs) -> %% User defined macros - {error,{redefine,M}}; - {ok,_Def} -> %% Predefined macros - {error,{redefine_predef,M}}; - error -> - A = line1(), - user_predef(Pdm, - dict:store({atom,M}, [{none, {none,[{atom,A,true}]}}], Ms)) - end; + user_predef([{M,true}|Pdm], Ms); user_predef([Md|_Pdm], _Ms) -> {error,{bad,Md}}; user_predef([], Ms) -> {ok,Ms}. @@ -615,7 +601,9 @@ wait_request(St) -> receive {epp_request,From,scan_erl_form} -> From; {epp_request,From,macro_defs} -> - epp_reply(From, dict:to_list(St#epp.macs)), + %% Return the old format to avoid any incompability issues. + Defs = [{{atom,K},V} || {K,V} <- maps:to_list(St#epp.macs)], + epp_reply(From, Defs), wait_request(St); {epp_request,From,close} -> close_file(St), @@ -667,7 +655,8 @@ enter_file(NewName, Inc, From, St) -> enter_file2(NewF, Pname, From, St0, AtLocation) -> Anno = erl_anno:new(AtLocation), enter_file_reply(From, Pname, Anno, AtLocation, code), - Ms = dict:store({atom,'FILE'}, {none,[{string,Anno,Pname}]}, St0#epp.macs), + Ms0 = St0#epp.macs, + Ms = Ms0#{'FILE':={none,[{string,Anno,Pname}]}}, %% update the head of the include path to be the directory of the new %% source file, so that an included file can always include other files %% relative to its current location (this is also how C does it); note @@ -688,7 +677,7 @@ enter_file_reply(From, Name, LocationAnno, AtLocation, Where) -> generated -> erl_anno:set_generated(true, Anno0) end, Rep = {ok, [{'-',Anno},{atom,Anno,file},{'(',Anno}, - {string,Anno,file_name(Name)},{',',Anno}, + {string,Anno,Name},{',',Anno}, {integer,Anno,get_line(LocationAnno)},{')',LocationAnno}, {dot,Anno}]}, epp_reply(From, Rep). @@ -719,9 +708,8 @@ leave_file(From, St) -> name2=OldName2} = OldSt, CurrLoc = add_line(OldLoc, Delta), Anno = erl_anno:new(CurrLoc), - Ms = dict:store({atom,'FILE'}, - {none,[{string,Anno,OldName2}]}, - St#epp.macs), + Ms0 = St#epp.macs, + Ms = Ms0#{'FILE':={none,[{string,Anno,OldName2}]}}, NextSt = OldSt#epp{sstk=Sts,macs=Ms,uses=St#epp.uses}, enter_file_reply(From, OldName, Anno, CurrLoc, code), case OldName2 =:= OldName of @@ -778,7 +766,7 @@ scan_toks([{'-',_Lh},{atom,_Le,elif}=Elif|Toks], From, St) -> scan_toks([{'-',_Lh},{atom,_Le,endif}=Endif|Toks], From, St) -> scan_endif(Toks, Endif, From, St); scan_toks([{'-',_Lh},{atom,_Lf,file}=FileToken|Toks0], From, St) -> - case catch expand_macros(Toks0, {St#epp.macs, St#epp.uses}) of + case catch expand_macros(Toks0, St) of Toks1 when is_list(Toks1) -> scan_file(Toks1, FileToken, From, St); {error,ErrL,What} -> @@ -786,7 +774,7 @@ scan_toks([{'-',_Lh},{atom,_Lf,file}=FileToken|Toks0], From, St) -> wait_req_scan(St) end; scan_toks(Toks0, From, St) -> - case catch expand_macros(Toks0, {St#epp.macs, St#epp.uses}) of + case catch expand_macros(Toks0, St#epp{fname=Toks0}) of Toks1 when is_list(Toks1) -> epp_reply(From, {ok,Toks1}), wait_req_scan(St#epp{macs=scan_module(Toks1, St#epp.macs)}); @@ -796,91 +784,48 @@ scan_toks(Toks0, From, St) -> end. scan_module([{'-',_Lh},{atom,_Lm,module},{'(',_Ll}|Ts], Ms) -> - scan_module_1(Ts, [], Ms); + scan_module_1(Ts, Ms); scan_module([{'-',_Lh},{atom,_Lm,extends},{'(',_Ll}|Ts], Ms) -> - scan_extends(Ts, [], Ms); + scan_extends(Ts, Ms); scan_module(_Ts, Ms) -> Ms. -scan_module_1([{atom,_,_}=A,{',',L}|Ts], As, Ms) -> +scan_module_1([{atom,_,_}=A,{',',L}|Ts], Ms) -> %% Parameterized modules. - scan_module_1([A,{')',L}|Ts], As, Ms); -scan_module_1([{atom,Ln,A},{')',_Lr}|_Ts], As, Ms0) -> - Mod = lists:concat(lists:reverse([A|As])), - Ms = dict:store({atom,'MODULE'}, - {none,[{atom,Ln,list_to_atom(Mod)}]}, Ms0), - dict:store({atom,'MODULE_STRING'}, {none,[{string,Ln,Mod}]}, Ms); -scan_module_1([{atom,_Ln,A},{'.',_Lr}|Ts], As, Ms) -> - scan_module_1(Ts, [".",A|As], Ms); -scan_module_1([{'.',_Lr}|Ts], As, Ms) -> - scan_module_1(Ts, As, Ms); -scan_module_1(_Ts, _As, Ms) -> Ms. - -scan_extends([{atom,Ln,A},{')',_Lr}|_Ts], As, Ms0) -> - Mod = lists:concat(lists:reverse([A|As])), - Ms = dict:store({atom,'BASE_MODULE'}, - {none,[{atom,Ln,list_to_atom(Mod)}]}, Ms0), - dict:store({atom,'BASE_MODULE_STRING'}, {none,[{string,Ln,Mod}]}, Ms); -scan_extends([{atom,_Ln,A},{'.',_Lr}|Ts], As, Ms) -> - scan_extends(Ts, [".",A|As], Ms); -scan_extends([{'.',_Lr}|Ts], As, Ms) -> - scan_extends(Ts, As, Ms); -scan_extends(_Ts, _As, Ms) -> Ms. + scan_module_1([A,{')',L}|Ts], Ms); +scan_module_1([{atom,Ln,A}=ModAtom,{')',_Lr}|_Ts], Ms0) -> + ModString = atom_to_list(A), + Ms = Ms0#{'MODULE':={none,[ModAtom]}}, + Ms#{'MODULE_STRING':={none,[{string,Ln,ModString}]}}; +scan_module_1(_Ts, Ms) -> Ms. + +scan_extends([{atom,Ln,A}=ModAtom,{')',_Lr}|_Ts], Ms0) -> + ModString = atom_to_list(A), + Ms = Ms0#{'BASE_MODULE':={none,[ModAtom]}}, + Ms#{'BASE_MODULE_STRING':={none,[{string,Ln,ModString}]}}; +scan_extends(_Ts, Ms) -> Ms. %% scan_define(Tokens, DefineToken, From, EppState) -scan_define([{'(',_Lp},{Type,_Lm,M}=Mac,{',',_}=Comma|Toks], _Def, From, St) +scan_define([{'(',_Lp},{Type,_Lm,_}=Mac|Toks], Def, From, St) when Type =:= atom; Type =:= var -> + scan_define_1(Toks, Mac, Def, From, St); +scan_define(_Toks, Def, From, St) -> + epp_reply(From, {error,{loc(Def),epp,{bad,define}}}), + wait_req_scan(St). + +scan_define_1([{',',_}=Comma|Toks], Mac,_Def, From, St) -> case catch macro_expansion(Toks, Comma) of Expansion when is_list(Expansion) -> - case dict:find({atom,M}, St#epp.macs) of - {ok, Defs} when is_list(Defs) -> - %% User defined macros: can be overloaded - case proplists:is_defined(none, Defs) of - true -> - epp_reply(From, {error,{loc(Mac),epp,{redefine,M}}}), - wait_req_scan(St); - false -> - scan_define_cont(From, St, - {atom, M}, - {none, {none,Expansion}}) - end; - {ok, _PreDef} -> - %% Predefined macros: cannot be overloaded - epp_reply(From, {error,{loc(Mac),epp,{redefine_predef,M}}}), - wait_req_scan(St); - error -> - scan_define_cont(From, St, - {atom, M}, - {none, {none,Expansion}}) - end; + scan_define_2(none, {none,Expansion}, Mac, From, St); {error,ErrL,What} -> epp_reply(From, {error,{ErrL,epp,What}}), wait_req_scan(St) end; -scan_define([{'(',_Lp},{Type,_Lm,M}=Mac,{'(',_Lc}|Toks], Def, From, St) - when Type =:= atom; Type =:= var -> +scan_define_1([{'(',_Lc}|Toks], Mac, Def, From, St) -> case catch macro_pars(Toks, []) of - {ok, {As,Me}} -> + {ok,{As,_}=MacroDef} -> Len = length(As), - case dict:find({atom,M}, St#epp.macs) of - {ok, Defs} when is_list(Defs) -> - %% User defined macros: can be overloaded - case proplists:is_defined(Len, Defs) of - true -> - epp_reply(From,{error,{loc(Mac),epp,{redefine,M}}}), - wait_req_scan(St); - false -> - scan_define_cont(From, St, {atom, M}, - {Len, {As, Me}}) - end; - {ok, _PreDef} -> - %% Predefined macros: cannot be overloaded - %% (There are currently no predefined F(...) macros.) - epp_reply(From, {error,{loc(Mac),epp,{redefine_predef,M}}}), - wait_req_scan(St); - error -> - scan_define_cont(From, St, {atom, M}, {Len, {As, Me}}) - end; + scan_define_2(Len, MacroDef, Mac, From, St); {error,ErrL,What} -> epp_reply(From, {error,{ErrL,epp,What}}), wait_req_scan(St); @@ -888,10 +833,29 @@ scan_define([{'(',_Lp},{Type,_Lm,M}=Mac,{'(',_Lc}|Toks], Def, From, St) epp_reply(From, {error,{loc(Def),epp,{bad,define}}}), wait_req_scan(St) end; -scan_define(_Toks, Def, From, St) -> +scan_define_1(_Toks, _Mac, Def, From, St) -> epp_reply(From, {error,{loc(Def),epp,{bad,define}}}), wait_req_scan(St). +scan_define_2(Arity, Def, {_,_,Key}=Mac, From, #epp{macs=Ms}=St) -> + case Ms of + #{Key:=Defs} when is_list(Defs) -> + %% User defined macros: can be overloaded + case proplists:is_defined(Arity, Defs) of + true -> + epp_reply(From, {error,{loc(Mac),epp,{redefine,Key}}}), + wait_req_scan(St); + false -> + scan_define_cont(From, St, Key, Defs, Arity, Def) + end; + #{Key:=_} -> + %% Predefined macros: cannot be overloaded + epp_reply(From, {error,{loc(Mac),epp,{redefine_predef,Key}}}), + wait_req_scan(St); + _ -> + scan_define_cont(From, St, Key, [], Arity, Def) + end. + %%% Detection of circular macro expansions (which would either keep %%% the compiler looping forever, or run out of memory): %%% When a macro is defined, we store the names of other macros it @@ -901,11 +865,17 @@ scan_define(_Toks, Def, From, St) -> %%% the information from St#epp.uses is traversed, and if a circularity %%% is detected, an error message is thrown. -scan_define_cont(F, St, M, {Arity, Def}) -> - Ms = dict:append_list(M, [{Arity, Def}], St#epp.macs), - try dict:append_list(M, [{Arity, macro_uses(Def)}], St#epp.uses) of +scan_define_cont(F, #epp{macs=Ms0}=St, M, Defs, Arity, Def) -> + Ms = Ms0#{M=>[{Arity,Def}|Defs]}, + try macro_uses(Def) of U -> - scan_toks(F, St#epp{uses=U, macs=Ms}) + Uses0 = St#epp.uses, + Val = [{Arity,U}|case Uses0 of + #{M:=UseList} -> UseList; + _ -> [] + end], + Uses = Uses0#{M=>Val}, + scan_toks(F, St#epp{uses=Uses,macs=Ms}) catch {error, Line, Reason} -> epp_reply(F, {error,{Line,epp,Reason}}), @@ -923,23 +893,23 @@ macro_ref([{'?', _}, {'?', _} | Rest]) -> macro_ref([{'?', _}, {atom, _, A}=Atom | Rest]) -> Lm = loc(Atom), Arity = count_args(Rest, Lm, A), - [{{atom, A}, Arity} | macro_ref(Rest)]; + [{A,Arity} | macro_ref(Rest)]; macro_ref([{'?', _}, {var, _, A}=Var | Rest]) -> Lm = loc(Var), Arity = count_args(Rest, Lm, A), - [{{atom, A}, Arity} | macro_ref(Rest)]; + [{A,Arity} | macro_ref(Rest)]; macro_ref([_Token | Rest]) -> macro_ref(Rest). %% scan_undef(Tokens, UndefToken, From, EppState) scan_undef([{'(',_Llp},{atom,_Lm,M},{')',_Lrp},{dot,_Ld}], _Undef, From, St) -> - Macs = dict:erase({atom,M}, St#epp.macs), - Uses = dict:erase({atom,M}, St#epp.uses), + Macs = maps:remove(M, St#epp.macs), + Uses = maps:remove(M, St#epp.uses), scan_toks(From, St#epp{macs=Macs, uses=Uses}); scan_undef([{'(',_Llp},{var,_Lm,M},{')',_Lrp},{dot,_Ld}], _Undef, From,St) -> - Macs = dict:erase({atom,M}, St#epp.macs), - Uses = dict:erase({atom,M}, St#epp.uses), + Macs = maps:remove(M, St#epp.macs), + Uses = maps:remove(M, St#epp.uses), scan_toks(From, St#epp{macs=Macs, uses=Uses}); scan_undef(_Toks, Undef, From, St) -> epp_reply(From, {error,{loc(Undef),epp,{bad,undef}}}), @@ -1006,17 +976,17 @@ scan_include_lib(_Toks, Inc, From, St) -> %% Report a badly formed if[n]def test and then treat as undefined macro. scan_ifdef([{'(',_Llp},{atom,_Lm,M},{')',_Lrp},{dot,_Ld}], _IfD, From, St) -> - case dict:find({atom,M}, St#epp.macs) of - {ok,_Def} -> + case St#epp.macs of + #{M:=_Def} -> scan_toks(From, St#epp{istk=[ifdef|St#epp.istk]}); - error -> + _ -> skip_toks(From, St, [ifdef]) end; scan_ifdef([{'(',_Llp},{var,_Lm,M},{')',_Lrp},{dot,_Ld}], _IfD, From, St) -> - case dict:find({atom,M}, St#epp.macs) of - {ok,_Def} -> + case St#epp.macs of + #{M:=_Def} -> scan_toks(From, St#epp{istk=[ifdef|St#epp.istk]}); - error -> + _ -> skip_toks(From, St, [ifdef]) end; scan_ifdef(_Toks, IfDef, From, St) -> @@ -1024,17 +994,17 @@ scan_ifdef(_Toks, IfDef, From, St) -> wait_req_skip(St, [ifdef]). scan_ifndef([{'(',_Llp},{atom,_Lm,M},{')',_Lrp},{dot,_Ld}], _IfnD, From, St) -> - case dict:find({atom,M}, St#epp.macs) of - {ok,_Def} -> + case St#epp.macs of + #{M:=_Def} -> skip_toks(From, St, [ifndef]); - error -> + _ -> scan_toks(From, St#epp{istk=[ifndef|St#epp.istk]}) end; scan_ifndef([{'(',_Llp},{var,_Lm,M},{')',_Lrp},{dot,_Ld}], _IfnD, From, St) -> - case dict:find({atom,M}, St#epp.macs) of - {ok,_Def} -> + case St#epp.macs of + #{M:=_Def} -> skip_toks(From, St, [ifndef]); - error -> + _ -> scan_toks(From, St#epp{istk=[ifndef|St#epp.istk]}) end; scan_ifndef(_Toks, IfnDef, From, St) -> @@ -1102,7 +1072,8 @@ scan_file([{'(',_Llp},{string,_Ls,Name},{',',_Lc},{integer,_Li,Ln},{')',_Lrp}, {dot,_Ld}], Tf, From, St) -> Anno = erl_anno:new(Ln), enter_file_reply(From, Name, Anno, loc(Tf), generated), - Ms = dict:store({atom,'FILE'}, {none,[{string,line1(),Name}]}, St#epp.macs), + Ms0 = St#epp.macs, + Ms = Ms0#{'FILE':={none,[{string,line1(),Name}]}}, Locf = loc(Tf), NewLoc = new_location(Ln, St#epp.location, Locf), Delta = get_line(element(2, Tf))-Ln + St#epp.delta, @@ -1185,45 +1156,47 @@ macro_expansion([T|Ts], _Anno0) -> [T|macro_expansion(Ts, T)]; macro_expansion([], Anno0) -> throw({error,loc(Anno0),premature_end}). -%% expand_macros(Tokens, Macros) +%% expand_macros(Tokens, St) %% expand_macro(Tokens, MacroToken, RestTokens) %% Expand the macros in a list of tokens, making sure that an expansion %% gets the same location as the macro call. -expand_macros(Type, MacT, M, Toks, Ms0) -> - %% (Type will always be 'atom') - {Ms, U} = Ms0, +expand_macros(MacT, M, Toks, St) -> + #epp{macs=Ms,uses=U} = St, Lm = loc(MacT), Tinfo = element(2, MacT), - case expand_macro1(Type, Lm, M, Toks, Ms) of + case expand_macro1(Lm, M, Toks, Ms) of {ok,{none,Exp}} -> - check_uses([{{Type,M}, none}], [], U, Lm), - Toks1 = expand_macros(expand_macro(Exp, Tinfo, [], dict:new()), Ms0), - expand_macros(Toks1++Toks, Ms0); + check_uses([{M,none}], [], U, Lm), + Toks1 = expand_macros(expand_macro(Exp, Tinfo, [], #{}), St), + expand_macros(Toks1++Toks, St); {ok,{As,Exp}} -> - check_uses([{{Type,M}, length(As)}], [], U, Lm), - {Bs,Toks1} = bind_args(Toks, Lm, M, As, dict:new()), - expand_macros(expand_macro(Exp, Tinfo, Toks1, Bs), Ms0) + check_uses([{M,length(As)}], [], U, Lm), + {Bs,Toks1} = bind_args(Toks, Lm, M, As, #{}), + expand_macros(expand_macro(Exp, Tinfo, Toks1, Bs), St) end. -expand_macro1(Type, Lm, M, Toks, Ms) -> +expand_macro1(Lm, M, Toks, Ms) -> Arity = count_args(Toks, Lm, M), - case dict:find({Type,M}, Ms) of - error -> %% macro not found + case Ms of + #{M:=undefined} -> + %% Predefined macro without definition. throw({error,Lm,{undefined,M,Arity}}); - {ok, undefined} -> %% Predefined macro without definition - throw({error,Lm,{undefined,M,Arity}}); - {ok, [{none, Def}]} -> - {ok, Def}; - {ok, Defs} when is_list(Defs) -> - case proplists:get_value(Arity, Defs) of + #{M:=[{none,Def}]} -> + {ok,Def}; + #{M:=Defs} when is_list(Defs) -> + case proplists:get_value(Arity, Defs) of undefined -> throw({error,Lm,{mismatch,M}}); Def -> - {ok, Def} + {ok,Def} end; - {ok, PreDef} -> %% Predefined macro - {ok, PreDef} + #{M:=PreDef} -> + %% Predefined macro. + {ok,PreDef}; + _ -> + %% Macro not found. + throw({error,Lm,{undefined,M,Arity}}) end. check_uses([], _Anc, _U, _Lm) -> @@ -1231,7 +1204,7 @@ check_uses([], _Anc, _U, _Lm) -> check_uses([M|Rest], Anc, U, Lm) -> case lists:member(M, Anc) of true -> - {{_, Name},Arity} = M, + {Name,Arity} = M, throw({error,Lm,{circular,Name,Arity}}); false -> L = get_macro_uses(M, U), @@ -1240,25 +1213,41 @@ check_uses([M|Rest], Anc, U, Lm) -> end. get_macro_uses({M,Arity}, U) -> - case dict:find(M, U) of - error -> - []; - {ok, L} -> - proplists:get_value(Arity, L, proplists:get_value(none, L, [])) + case U of + #{M:=L} -> + proplists:get_value(Arity, L, proplists:get_value(none, L, [])); + _ -> + [] end. %% Macro expansion %% Note: io:scan_erl_form() does not return comments or white spaces. -expand_macros([{'?',_Lq},{atom,_Lm,M}=MacT|Toks], Ms) -> - expand_macros(atom, MacT, M, Toks, Ms); +expand_macros([{'?',_Lq},{atom,_Lm,M}=MacT|Toks], St) -> + expand_macros(MacT, M, Toks, St); %% Special macros -expand_macros([{'?',_Lq},{var,Lm,'LINE'}=Tok|Toks], Ms) -> +expand_macros([{'?',_Lq},{var,Lm,'FUNCTION_NAME'}=Token|Toks], St0) -> + St = update_fun_name(Token, St0), + case St#epp.fname of + undefined -> + [{'?',_Lq},Token]; + {Name,_} -> + [{atom,Lm,Name}] + end ++ expand_macros(Toks, St); +expand_macros([{'?',_Lq},{var,Lm,'FUNCTION_ARITY'}=Token|Toks], St0) -> + St = update_fun_name(Token, St0), + case St#epp.fname of + undefined -> + [{'?',_Lq},Token]; + {_,Arity} -> + [{integer,Lm,Arity}] + end ++ expand_macros(Toks, St); +expand_macros([{'?',_Lq},{var,Lm,'LINE'}=Tok|Toks], St) -> Line = erl_scan:line(Tok), - [{integer,Lm,Line}|expand_macros(Toks, Ms)]; -expand_macros([{'?',_Lq},{var,_Lm,M}=MacT|Toks], Ms) -> - expand_macros(atom, MacT, M, Toks, Ms); + [{integer,Lm,Line}|expand_macros(Toks, St)]; +expand_macros([{'?',_Lq},{var,_Lm,M}=MacT|Toks], St) -> + expand_macros(MacT, M, Toks, St); %% Illegal macros -expand_macros([{'?',_Lq},Token|_Toks], _Ms) -> +expand_macros([{'?',_Lq},Token|_Toks], _St) -> T = case erl_scan:text(Token) of Text when is_list(Text) -> Text; @@ -1267,9 +1256,9 @@ expand_macros([{'?',_Lq},Token|_Toks], _Ms) -> io_lib:write(Symbol) end, throw({error,loc(Token),{call,[$?|T]}}); -expand_macros([T|Ts], Ms) -> - [T|expand_macros(Ts, Ms)]; -expand_macros([], _Ms) -> []. +expand_macros([T|Ts], St) -> + [T|expand_macros(Ts, St)]; +expand_macros([], _St) -> []. %% bind_args(Tokens, MacroLocation, MacroName, ArgumentVars, Bindings) %% Collect the arguments to a macro call. @@ -1295,7 +1284,7 @@ macro_args(_Toks, Lm, M, _As, _Bs) -> store_arg(L, M, _A, [], _Bs) -> throw({error,L,{mismatch,M}}); store_arg(_L, _M, A, Arg, Bs) -> - dict:store(A, Arg, Bs). + Bs#{A=>Arg}. %% count_args(Tokens, MacroLine, MacroName) %% Count the number of arguments in a macro call. @@ -1368,19 +1357,17 @@ macro_arg([], _E, Arg) -> %% and then the macro arguments, i.e. simulate textual expansion. expand_macro([{var,_Lv,V}|Ts], L, Rest, Bs) -> - case dict:find(V, Bs) of - {ok,Val} -> - %% lists:append(Val, expand_macro(Ts, L, Rest, Bs)); + case Bs of + #{V:=Val} -> expand_arg(Val, Ts, L, Rest, Bs); - error -> + _ -> [{var,L,V}|expand_macro(Ts, L, Rest, Bs)] end; expand_macro([{'?', _}, {'?', _}, {var,_Lv,V}|Ts], L, Rest, Bs) -> - case dict:find(V, Bs) of - {ok,Val} -> - %% lists:append(Val, expand_macro(Ts, L, Rest, Bs)); + case Bs of + #{V:=Val} -> expand_arg(stringify(Val, L), Ts, L, Rest, Bs); - error -> + _ -> [{var,L,V}|expand_macro(Ts, L, Rest, Bs)] end; expand_macro([T|Ts], L, Rest, Bs) -> @@ -1394,6 +1381,93 @@ expand_arg([A|As], Ts, _L, Rest, Bs) -> expand_arg([], Ts, L, Rest, Bs) -> expand_macro(Ts, L, Rest, Bs). +%%% +%%% Here follows support for the ?FUNCTION_NAME and ?FUNCTION_ARITY +%%% macros. Since the parser has not been run yet, we don't know the +%%% name and arity of the current function. Therefore, we will need to +%%% scan the beginning of the current form to extract the name and +%%% arity of the function. +%%% + +update_fun_name(Token, #epp{fname=Toks0}=St) when is_list(Toks0) -> + %% ?FUNCTION_NAME or ?FUNCTION_ARITY is used for the first time in + %% a function. First expand macros (except ?FUNCTION_NAME and + %% ?FUNCTION_ARITY) in the form. + + Toks1 = (catch expand_macros(Toks0, St#epp{fname=undefined})), + + %% Now extract the name and arity from the stream of tokens, and store + %% the result in the #epp{} record so we don't have to do it + %% again. + + case Toks1 of + [{atom,_,Name},{'(',_}|Toks] -> + %% This is the beginning of a function definition. + %% Scan the token stream up to the matching right + %% parenthesis and count the number of arguments. + FA = update_fun_name_1(Toks, 1, {Name,0}, St), + St#epp{fname=FA}; + [{'?',_}|_] -> + %% ?FUNCTION_NAME/?FUNCTION_ARITY used at the beginning + %% of a form. Does not make sense. + {var,_,Macro} = Token, + throw({error,loc(Token),{illegal_function_usage,Macro}}); + _ when is_list(Toks1) -> + %% Not the beginning of a function (an attribute or a + %% syntax error). + {var,_,Macro} = Token, + throw({error,loc(Token),{illegal_function,Macro}}); + _ -> + %% A macro expansion error. Return a dummy value and + %% let the caller notice and handle the error. + St#epp{fname={'_',0}} + end; +update_fun_name(_Token, St) -> + St. + +update_fun_name_1([Tok|Toks], L, FA, St) -> + case classify_token(Tok) of + comma -> + if + L =:= 1 -> + {Name,Arity} = FA, + update_fun_name_1(Toks, L, {Name,Arity+1}, St); + true -> + update_fun_name_1(Toks, L, FA, St) + end; + left -> + update_fun_name_1(Toks, L+1, FA, St); + right when L =:= 1 -> + FA; + right -> + update_fun_name_1(Toks, L-1, FA, St); + other -> + case FA of + {Name,0} -> + update_fun_name_1(Toks, L, {Name,1}, St); + {_,_} -> + update_fun_name_1(Toks, L, FA, St) + end + end; +update_fun_name_1([], _, FA, _) -> + %% Syntax error, but never mind. + FA. + +classify_token({C,_}) -> classify_token_1(C); +classify_token(_) -> other. + +classify_token_1(',') -> comma; +classify_token_1('(') -> left; +classify_token_1('{') -> left; +classify_token_1('[') -> left; +classify_token_1('<<') -> left; +classify_token_1(')') -> right; +classify_token_1('}') -> right; +classify_token_1(']') -> right; +classify_token_1('>>') -> right; +classify_token_1(_) -> other. + + %%% stringify(Ts, L) returns a list of one token: a string which when %%% tokenized would yield the token list Ts. diff --git a/lib/stdlib/src/erl_anno.erl b/lib/stdlib/src/erl_anno.erl index 143318aa55..d32c34dabd 100644 --- a/lib/stdlib/src/erl_anno.erl +++ b/lib/stdlib/src/erl_anno.erl @@ -33,7 +33,7 @@ -export_type([anno_term/0]). --define(LN(L), is_integer(L)). +-define(LN(L), is_integer(L), L >= 0). -define(COL(C), (is_integer(C) andalso C >= 1)). %% Location. @@ -52,13 +52,13 @@ | {'record', record()} | {'text', string()}. --type anno() :: location() | [annotation(), ...]. +-opaque anno() :: location() | [annotation(), ...]. -type anno_term() :: term(). -type column() :: pos_integer(). -type generated() :: boolean(). -type filename() :: file:filename_all(). --type line() :: integer(). +-type line() :: non_neg_integer(). -type location() :: line() | {line(), column()}. -type record() :: boolean(). -type text() :: string(). @@ -90,9 +90,13 @@ to_term(Anno) -> -ifdef(DEBUG). from_term(Term) when is_list(Term) -> Term; +from_term(Line) when is_integer(Line), Line < 0 -> % Before OTP 19 + set_generated(true, new(-Line)); from_term(Term) -> [{location, Term}]. -else. +from_term(Line) when is_integer(Line), Line < 0 -> % Before OTP 19 + set_generated(true, new(-Line)); from_term(Term) -> Term. -endif. @@ -198,18 +202,11 @@ file(Anno) -> Anno :: anno(). generated(Line) when ?ALINE(Line) -> - Line =< 0; + false; generated({Line, Column}) when ?ALINE(Line), ?ACOLUMN(Column) -> - Line =< 0; + false; generated(Anno) -> - _ = anno_info(Anno, generated, false), - {location, Location} = lists:keyfind(location, 1, Anno), - case Location of - {Line, _Column} -> - Line =< 0; - Line -> - Line =< 0 - end. + anno_info(Anno, generated, false). -spec line(Anno) -> line() when Anno :: anno(). @@ -226,18 +223,11 @@ line(Anno) -> Anno :: anno(). location(Line) when ?ALINE(Line) -> - abs(Line); -location({Line, Column}) when ?ALINE(Line), ?ACOLUMN(Column) -> - {abs(Line), Column}; + Line; +location({Line, Column}=Location) when ?ALINE(Line), ?ACOLUMN(Column) -> + Location; location(Anno) -> - case anno_info(Anno, location) of - Line when Line < 0 -> - -Line; - {Line, Column} when Line < 0 -> - {-Line, Column}; - Location -> - Location - end. + anno_info(Anno, location). -spec record(Anno) -> record() when Anno :: anno(). @@ -270,31 +260,8 @@ set_file(File, Anno) -> Generated :: generated(), Anno :: anno(). -set_generated(true, Line) when ?ALINE(Line) -> - -abs(Line); -set_generated(false, Line) when ?ALINE(Line) -> - abs(Line); -set_generated(true, {Line, Column}) when ?ALINE(Line), - ?ACOLUMN(Column) -> - {-abs(Line),Column}; -set_generated(false, {Line, Column}) when ?ALINE(Line), - ?ACOLUMN(Column) -> - {abs(Line),Column}; set_generated(Generated, Anno) -> - _ = set(generated, Generated, Anno), - {location, Location} = lists:keyfind(location, 1, Anno), - NewLocation = - case Location of - {Line, Column} when Generated -> - {-abs(Line), Column}; - {Line, Column} when not Generated -> - {abs(Line), Column}; - Line when Generated -> - -abs(Line); - Line when not Generated -> - abs(Line) - end, - lists:keyreplace(location, 1, Anno, {location, NewLocation}). + set(generated, Generated, Anno). -spec set_line(Line, Anno) -> Anno when Line :: line(), @@ -313,38 +280,17 @@ set_line(Line, Anno) -> Anno :: anno(). set_location(Line, L) when ?ALINE(L), ?LLINE(Line) -> - new_location(fix_line(Line, L)); + new_location(Line); set_location(Line, {L, Column}) when ?ALINE(L), ?ACOLUMN(Column), ?LLINE(Line) -> - new_location(fix_line(Line, L)); + new_location(Line); set_location({L, C}=Loc, Line) when ?ALINE(Line), ?LLINE(L), ?LCOLUMN(C) -> - new_location(fix_location(Loc, Line)); + new_location(Loc); set_location({L, C}=Loc, {Line, Column}) when ?ALINE(Line), ?ACOLUMN(Column), ?LLINE(L), ?LCOLUMN(C) -> - new_location(fix_location(Loc, Line)); + new_location(Loc); set_location(Location, Anno) -> - _ = set(location, Location, Anno), - {location, OldLocation} = lists:keyfind(location, 1, Anno), - NewLocation = - case {Location, OldLocation} of - {{_Line, _Column}=Loc, {L, _C}} -> - fix_location(Loc, L); - {Line, {L, _C}} -> - fix_line(Line, L); - {{_Line, _Column}=Loc, L} -> - fix_location(Loc, L); - {Line, L} -> - fix_line(Line, L) - end, - lists:keyreplace(location, 1, Anno, {location, NewLocation}). - -fix_location({Line, Column}, OldLine) -> - {fix_line(Line, OldLine), Column}. - -fix_line(Line, OldLine) when OldLine < 0, Line > 0 -> - -Line; -fix_line(Line, _OldLine) -> - Line. + set(location, Location, Anno). -spec set_record(Record, Anno) -> Anno when Record :: record(), @@ -383,7 +329,7 @@ set_anno(Item, Value, Anno) -> _ -> lists:keyreplace(Item, 1, Anno, {Item, Value}) end, - simplify(R) + reset_simplify(R) end. reset(Anno, Item) -> diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl index ca3cc43b19..40a34aa30f 100644 --- a/lib/stdlib/src/erl_eval.erl +++ b/lib/stdlib/src/erl_eval.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2015. 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. @@ -415,7 +415,7 @@ expr({call,_,{atom,_,Func},As0}, Bs0, Lf, Ef, RBs) -> {As,Bs} = expr_list(As0, Bs0, Lf, Ef), bif(Func, As, Bs, Ef, RBs); false -> - local_func(Func, As0, Bs0, Lf, RBs) + local_func(Func, As0, Bs0, Lf, Ef, RBs) end; expr({call,_,Func0,As0}, Bs0, Lf, Ef, RBs) -> % function or {Mod,Fun} {value,Func,Bs1} = expr(Func0, Bs0, Lf, Ef, none), @@ -542,33 +542,34 @@ unhide_calls([E | Es], MaxLine, D) -> unhide_calls(E, _MaxLine, _D) -> E. -%% local_func(Function, Arguments, Bindings, LocalFuncHandler, RBs) -> +%% local_func(Function, Arguments, Bindings, LocalFuncHandler, +%% ExternalFuncHandler, RBs) -> %% {value,Value,Bindings} | Value when %% LocalFuncHandler = {value,F} | {value,F,Eas} | %% {eval,F} | {eval,F,Eas} | none. -local_func(Func, As0, Bs0, {value,F}, value) -> - {As1,_Bs1} = expr_list(As0, Bs0, {value,F}), +local_func(Func, As0, Bs0, {value,F}, Ef, value) -> + {As1,_Bs1} = expr_list(As0, Bs0, {value,F}, Ef), %% Make tail recursive calls when possible. F(Func, As1); -local_func(Func, As0, Bs0, {value,F}, RBs) -> - {As1,Bs1} = expr_list(As0, Bs0, {value,F}), +local_func(Func, As0, Bs0, {value,F}, Ef, RBs) -> + {As1,Bs1} = expr_list(As0, Bs0, {value,F}, Ef), ret_expr(F(Func, As1), Bs1, RBs); -local_func(Func, As0, Bs0, {value,F,Eas}, RBs) -> +local_func(Func, As0, Bs0, {value,F,Eas}, Ef, RBs) -> Fun = fun(Name, Args) -> apply(F, [Name,Args|Eas]) end, - local_func(Func, As0, Bs0, {value, Fun}, RBs); -local_func(Func, As, Bs, {eval,F}, RBs) -> + local_func(Func, As0, Bs0, {value, Fun}, Ef, RBs); +local_func(Func, As, Bs, {eval,F}, _Ef, RBs) -> local_func2(F(Func, As, Bs), RBs); -local_func(Func, As, Bs, {eval,F,Eas}, RBs) -> +local_func(Func, As, Bs, {eval,F,Eas}, _Ef, RBs) -> local_func2(apply(F, [Func,As,Bs|Eas]), RBs); %% These two clauses are for backwards compatibility. -local_func(Func, As0, Bs0, {M,F}, RBs) -> - {As1,Bs1} = expr_list(As0, Bs0, {M,F}), +local_func(Func, As0, Bs0, {M,F}, Ef, RBs) -> + {As1,Bs1} = expr_list(As0, Bs0, {M,F}, Ef), ret_expr(M:F(Func,As1), Bs1, RBs); -local_func(Func, As, _Bs, {M,F,Eas}, RBs) -> +local_func(Func, As, _Bs, {M,F,Eas}, _Ef, RBs) -> local_func2(apply(M, F, [Func,As|Eas]), RBs); %% Default unknown function handler to undefined function. -local_func(Func, As0, _Bs0, none, _RBs) -> +local_func(Func, As0, _Bs0, none, _Ef, _RBs) -> erlang:raise(error, undef, [{erl_eval,Func,length(As0)}|stacktrace()]). local_func2({value,V,Bs}, RBs) -> @@ -1184,7 +1185,7 @@ match_tuple([], _, _, Bs, _BBs) -> match_map([{map_field_exact, _, K, V}|Fs], Map, Bs0, BBs) -> Vm = try - {value, Ke, _} = expr(K, Bs0), + {value, Ke, _} = expr(K, BBs), maps:get(Ke,Map) catch error:_ -> throw(nomatch) diff --git a/lib/stdlib/src/erl_expand_records.erl b/lib/stdlib/src/erl_expand_records.erl index bcfeef7321..9c0a7fb7d5 100644 --- a/lib/stdlib/src/erl_expand_records.erl +++ b/lib/stdlib/src/erl_expand_records.erl @@ -33,8 +33,6 @@ vcount=0, % Variable counter imports=[], % Imports records=dict:new(), % Record definitions - trecords=sets:new(), % Typed records - uses_types=false, % Are there -spec or -type in the module strict_ra=[], % strict record accesses checked_ra=[] % successfully accessed records }). @@ -47,45 +45,18 @@ %% erl_lint without errors. module(Fs0, Opts0) -> Opts = compiler_options(Fs0) ++ Opts0, - TRecs = typed_records(Fs0), - UsesTypes = uses_types(Fs0), - St0 = #exprec{compile = Opts, trecords = TRecs, uses_types = UsesTypes}, + St0 = #exprec{compile = Opts}, {Fs,_St} = forms(Fs0, St0), Fs. compiler_options(Forms) -> lists:flatten([C || {attribute,_,compile,C} <- Forms]). -typed_records(Fs) -> - typed_records(Fs, sets:new()). - -typed_records([{attribute,_L,type,{{record, Name},_Defs,[]}} | Fs], Trecs) -> - typed_records(Fs, sets:add_element(Name, Trecs)); -typed_records([_|Fs], Trecs) -> - typed_records(Fs, Trecs); -typed_records([], Trecs) -> - Trecs. - -uses_types([{attribute,_L,spec,_}|_]) -> true; -uses_types([{attribute,_L,type,_}|_]) -> true; -uses_types([{attribute,_L,opaque,_}|_]) -> true; -uses_types([_|Fs]) -> uses_types(Fs); -uses_types([]) -> false. - -forms([{attribute,L,record,{Name,Defs}} | Fs], St0) -> +forms([{attribute,_,record,{Name,Defs}}=Attr | Fs], St0) -> NDefs = normalise_fields(Defs), St = St0#exprec{records=dict:store(Name, NDefs, St0#exprec.records)}, {Fs1, St1} = forms(Fs, St), - %% Check if we need to keep the record information for usage in types. - case St#exprec.uses_types of - true -> - case sets:is_element(Name, St#exprec.trecords) of - true -> {Fs1, St1}; - false -> {[{attribute,L,type,{{record,Name},Defs,[]}}|Fs1], St1} - end; - false -> - {Fs1, St1} - end; + {[Attr | Fs1], St1}; forms([{attribute,L,import,Is} | Fs0], St0) -> St1 = import(Is, St0), {Fs,St2} = forms(Fs0, St1), @@ -513,7 +484,6 @@ lc_tq(Line, [F0 | Qs0], St0) -> lc_tq(_Line, [], St0) -> {[],St0#exprec{checked_ra = []}}. - %% normalise_fields([RecDef]) -> [Field]. %% Normalise the field definitions to always have a default value. If %% none has been given then use 'undefined'. diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index 5678e7eebe..4ca9a609a8 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2015. 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. @@ -31,12 +31,8 @@ -export([is_guard_expr/1]). -export([bool_option/4,value_option/3,value_option/7]). --export([modify_line/2]). - -import(lists, [member/2,map/2,foldl/3,foldr/3,mapfoldl/3,all/2,reverse/1]). --deprecated([{modify_line, 2, next_major_release}]). - %% bool_option(OnOpt, OffOpt, Default, Options) -> boolean(). %% value_option(Flag, Default, Options) -> Value. %% value_option(Flag, Default, OnOpt, OnVal, OffOpt, OffVal, Options) -> @@ -79,7 +75,7 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> %%-define(DEBUGF(X,Y), io:format(X, Y)). -define(DEBUGF(X,Y), void). --type line() :: erl_anno:line(). % a convenient alias +-type line() :: erl_anno:anno(). % a convenient alias -type fa() :: {atom(), arity()}. % function+arity -type ta() :: {atom(), arity()}. % type+arity @@ -100,7 +96,7 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> %% 'called' and 'exports' contain {Line, {Function, Arity}}, %% the other function collections contain {Function, Arity}. -record(lint, {state=start :: 'start' | 'attribute' | 'function', - module=[], %Module + module='', %Module behaviour=[], %Behaviour exports=gb_sets:empty() :: gb_sets:set(fa()),%Exports imports=[] :: [fa()], %Imports, an orddict() @@ -238,6 +234,9 @@ format_error({removed, MFA, ReplacementMFA, Rel}) -> "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)]); format_error({obsolete_guard, {F, A}}) -> io_lib:format("~p/~p obsolete", [F, A]); format_error({too_many_arguments,Arity}) -> @@ -361,6 +360,9 @@ format_error({redefine_type, {TypeName, Arity}}) -> [TypeName, gen_type_paren(Arity)]); format_error({type_syntax, Constr}) -> io_lib:format("bad ~w type", [Constr]); +format_error(old_abstract_code) -> + io_lib:format("abstract code generated before Erlang/OTP 19.0 and " + "having typed record fields cannot be compiled", []); format_error({redefine_spec, {M, F, A}}) -> io_lib:format("spec for ~w:~w/~w already defined", [M, F, A]); format_error({redefine_spec, {F, A}}) -> @@ -374,9 +376,9 @@ format_error({spec_fun_undefined, {F, A}}) -> format_error({missing_spec, {F,A}}) -> io_lib:format("missing specification for function ~w/~w", [F, A]); format_error(spec_wrong_arity) -> - "spec has the wrong arity"; + "spec has wrong arity"; format_error(callback_wrong_arity) -> - "callback has the wrong arity"; + "callback has wrong arity"; format_error({deprecated_builtin_type, {Name, Arity}, Replacement, Rel}) -> UseS = case Replacement of @@ -416,6 +418,9 @@ format_mfa({M, F, A}) when is_integer(A) -> format_mf(M, F, ArityString) when is_atom(M), is_atom(F) -> atom_to_list(M) ++ ":" ++ atom_to_list(F) ++ "/" ++ ArityString. +format_mna({M, N, A}) when is_integer(A) -> + atom_to_list(M) ++ ":" ++ atom_to_list(N) ++ gen_type_paren(A). + format_where(L) when is_integer(L) -> io_lib:format("(line ~p)", [L]); format_where({L,C}) when is_integer(L), is_integer(C) -> @@ -694,7 +699,12 @@ set_form_file({function,L,N,A,C}, File) -> set_form_file(Form, _File) -> Form. +set_file(Ts, File) when is_list(Ts) -> + [anno_set_file(T, File) || T <- Ts]; set_file(T, File) -> + anno_set_file(T, File). + +anno_set_file(T, File) -> F = fun(Anno) -> erl_anno:set_file(File, Anno) end, erl_parse:map_anno(F, T). @@ -729,7 +739,7 @@ start_state(Form, St) -> %% attribute_state(Form, State) -> %% State' -attribute_state({attribute,_L,module,_M}, #lint{module=[]}=St) -> +attribute_state({attribute,_L,module,_M}, #lint{module=''}=St) -> St; attribute_state({attribute,L,module,_M}, St) -> add_error(L, redefine_module, St); @@ -1136,7 +1146,7 @@ check_untyped_records(Forms, St0) -> RecNames = dict:fetch_keys(St0#lint.records), %% these are the records with field(s) containing type info TRecNames = [Name || - {attribute,_,type,{{record,Name},Fields,_}} <- Forms, + {attribute,_,record,{Name,Fields}} <- Forms, lists:all(fun ({typed_record_field,_,_}) -> true; (_) -> false end, Fields)], @@ -1146,7 +1156,8 @@ check_untyped_records(Forms, St0) -> [] -> St; % exclude records with no fields [_|_] -> add_warning(L, {untyped_record, N}, St) end - end, St0, RecNames -- TRecNames); + end, St0, ordsets:subtract(ordsets:from_list(RecNames), + ordsets:from_list(TRecNames))); false -> St0 end. @@ -2436,7 +2447,10 @@ record_def(Line, Name, Fs0, St0) -> true -> add_error(Line, {redefine_record,Name}, St0); false -> {Fs1,St1} = def_fields(normalise_fields(Fs0), Name, St0), - St1#lint{records=dict:store(Name, {Line,Fs1}, St1#lint.records)} + St2 = St1#lint{records=dict:store(Name, {Line,Fs1}, + St1#lint.records)}, + Types = [T || {typed_record_field, _, T} <- Fs0], + check_type({type, nowarn(), product, Types}, St2) end. %% def_fields([RecDef], RecordName, State) -> {[DefField],State}. @@ -2639,11 +2653,6 @@ find_field(_F, []) -> error. %% Attr :: 'type' | 'opaque' %% Checks that a type definition is valid. -type_def(_Attr, _Line, {record, _RecName}, Fields, [], St0) -> - %% The record field names and such are checked in the record format. - %% We only need to check the types. - Types = [T || {typed_record_field, _, T} <- Fields], - check_type({type, nowarn(), product, Types}, St0); type_def(Attr, Line, TypeName, ProtoType, Args, St0) -> TypeDefs = St0#lint.types, Arity = length(Args), @@ -2806,6 +2815,8 @@ check_type({user_type, L, TypeName, Args}, SeenVars, St) -> lists:foldl(fun(T, {AccSeenVars, AccSt}) -> check_type(T, AccSeenVars, AccSt) end, {SeenVars, St1}, Args); +check_type([{typed_record_field,Field,_T}|_], SeenVars, St) -> + {SeenVars, add_error(element(2, Field), old_abstract_code, St)}; check_type(I, SeenVars, St) -> case erl_eval:partial_eval(I) of {integer,_ILn,_Integer} -> {SeenVars, St}; @@ -2876,7 +2887,7 @@ spec_decl(Line, MFA0, TypeSpecs, St0 = #lint{specs = Specs, module = Mod}) -> St1 = St0#lint{specs = dict:store(MFA, Line, Specs)}, case dict:is_key(MFA, Specs) of true -> add_error(Line, {redefine_spec, MFA0}, St1); - false -> check_specs(TypeSpecs, Arity, St1) + false -> check_specs(TypeSpecs, spec_wrong_arity, Arity, St1) end. %% callback_decl(Line, Fun, Types, State) -> State. @@ -2890,7 +2901,8 @@ callback_decl(Line, MFA0, TypeSpecs, St1 = St0#lint{callbacks = dict:store(MFA, Line, Callbacks)}, case dict:is_key(MFA, Callbacks) of true -> add_error(Line, {redefine_callback, MFA0}, St1); - false -> check_specs(TypeSpecs, Arity, St1) + false -> check_specs(TypeSpecs, callback_wrong_arity, + Arity, St1) end end. @@ -2927,7 +2939,7 @@ is_fa({FuncName, Arity}) when is_atom(FuncName), is_integer(Arity), Arity >= 0 -> true; is_fa(_) -> false. -check_specs([FunType|Left], Arity, St0) -> +check_specs([FunType|Left], ETag, Arity, St0) -> {FunType1, CTypes} = case FunType of {type, _, bounded_fun, [FT = {type, _, 'fun', _}, Cs]} -> @@ -2935,18 +2947,16 @@ check_specs([FunType|Left], Arity, St0) -> {FT, lists:append(Types0)}; {type, _, 'fun', _} = FT -> {FT, []} end, - SpecArity = - case FunType1 of - {type, L, 'fun', [any, _]} -> any; - {type, L, 'fun', [{type, _, product, D}, _]} -> length(D) - end, + {type, L, 'fun', [{type, _, product, D}, _]} = FunType1, + SpecArity = length(D), St1 = case Arity =:= SpecArity of true -> St0; - false -> add_error(L, spec_wrong_arity, St0) + false -> %% Cannot happen if called from the compiler. + add_error(L, ETag, St0) end, St2 = check_type({type, nowarn(), product, [FunType1|CTypes]}, St1), - check_specs(Left, Arity, St2); -check_specs([], _Arity, St) -> + check_specs(Left, ETag, Arity, St2); +check_specs([], _ETag, _Arity, St) -> St. nowarn() -> @@ -2988,9 +2998,10 @@ add_missing_spec_warnings(Forms, St0, Type) -> [{FA,L} || {function,L,F,A,_} <- Forms, not lists:member(FA = {F,A}, Specs)]; exported -> - Exps = gb_sets:to_list(St0#lint.exports) -- pseudolocals(), + Exps0 = gb_sets:to_list(St0#lint.exports) -- pseudolocals(), + Exps = Exps0 -- Specs, [{FA,L} || {function,L,F,A,_} <- Forms, - member(FA = {F,A}, Exps -- Specs)] + member(FA = {F,A}, Exps)] end, foldl(fun ({FA,L}, St) -> add_warning(L, {missing_spec,FA}, St) @@ -3003,7 +3014,9 @@ check_unused_types(Forms, #lint{usage=Usage, types=Ts, exp_types=ExpTs}=St) -> L = gb_sets:to_list(ExpTs) ++ dict:fetch_keys(D), UsedTypes = gb_sets:from_list(L), FoldFun = - fun(Type, #typeinfo{line = FileLine}, AccSt) -> + fun({{record, _}=_Type, 0}, _, AccSt) -> + AccSt; % Before Erlang/OTP 19.0 + (Type, #typeinfo{line = FileLine}, AccSt) -> case loc(FileLine, AccSt) of {FirstFile, _} -> case gb_sets:is_member(Type, UsedTypes) of @@ -3190,8 +3203,8 @@ 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) -> - case member(binary, Flags) orelse member(bits, Flags) - orelse member(bitstring, Flags) of + case member(binary, Flags) orelse member(bytes, Flags) + orelse member(bits, Flags) orelse member(bitstring, Flags) of true -> add_error(Line, unsized_binary_in_bin_gen_pattern, St); false -> @@ -3485,13 +3498,6 @@ vt_no_unused(Vt) -> [V || {_,{_,U,_L}}=V <- Vt, U =/= unused]. copy_expr(Expr, Anno) -> erl_parse:map_anno(fun(_A) -> Anno end, Expr). -%% modify_line(Form, Fun) -> Form -%% modify_line(Expression, Fun) -> Expression -%% Applies Fun to each line number occurrence. - -modify_line(T, F0) -> - erl_parse:map_anno(F0, T). - %% Check a record_info call. We have already checked that it is not %% shadowed by an import. @@ -3532,6 +3538,8 @@ check_qlc_hrl(Line, M, F, As, St) -> %% deprecated_function(Line, ModName, FuncName, [Arg], State) -> State. %% Add warning for calls to deprecated functions. +-dialyzer({no_match, deprecated_function/5}). + deprecated_function(Line, M, F, As, St) -> Arity = length(As), MFA = {M, F, Arity}, @@ -3560,6 +3568,8 @@ deprecated_function(Line, M, F, As, St) -> St end. +-dialyzer({no_match, deprecated_type/5}). + deprecated_type(L, M, N, As, St) -> NAs = length(As), case otp_internal:obsolete_type(M, N, NAs) of @@ -3570,6 +3580,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); no -> St end. diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index e82282421e..b1c574ea60 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2015. 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. @@ -85,10 +85,6 @@ type_spec -> '(' spec_fun type_sigs ')' : {'$2', '$3'}. spec_fun -> atom : '$1'. spec_fun -> atom ':' atom : {'$1', '$3'}. -%% The following two are retained only for backwards compatibility; -%% they are not part of the EEP syntax and should be removed. -spec_fun -> atom '/' integer '::' : {'$1', '$3'}. -spec_fun -> atom ':' atom '/' integer '::' : {'$1', '$3', '$5'}. typed_attr_val -> expr ',' typed_record_fields : {typed_record, '$1', '$3'}. typed_attr_val -> expr '::' top_type : {type_def, '$1', '$3'}. @@ -525,23 +521,424 @@ Erlang code. -export([type_inop_prec/1,type_preop_prec/1]). -export([map_anno/2, fold_anno/3, mapfold_anno/3, new_anno/1, anno_to_term/1, anno_from_term/1]). --export([set_line/2,get_attribute/2,get_attributes/1]). - --deprecated([{set_line, 2, next_major_release}, - {get_attribute, 2, next_major_release}, - {get_attributes, 1, next_major_release}]). %% The following directive is needed for (significantly) faster compilation %% of the generated .erl file by the HiPE compiler. Please do not remove. -compile([{hipe,[{regalloc,linear_scan}]}]). -export_type([abstract_clause/0, abstract_expr/0, abstract_form/0, - error_info/0]). + abstract_type/0, error_info/0]). + +%% Start of Abstract Format + +-type anno() :: erl_anno:anno(). + +-type abstract_form() :: af_module() + | af_behavior() + | af_behaviour() + | af_export() + | af_import() + | af_export_type() + | af_optional_callbacks() + | af_compile() + | af_file() + | af_record_decl() + | af_type_decl() + | af_function_spec() + | af_wild_attribute() + | af_function_decl(). + +-type af_module() :: {'attribute', anno(), 'module', module()}. + +-type af_behavior() :: {'attribute', anno(), 'behavior', behaviour()}. + +-type af_behaviour() :: {'attribute', anno(), 'behaviour', behaviour()}. + +-type behaviour() :: atom(). + +-type af_export() :: {'attribute', anno(), 'export', af_fa_list()}. + +-type af_import() :: {'attribute', anno(), 'import', af_fa_list()}. + +-type af_fa_list() :: [{function_name(), arity()}]. + +-type af_export_type() :: {'attribute', anno(), 'export_type', af_ta_list()}. + +-type af_ta_list() :: [{type_name(), arity()}]. + +-type af_optional_callbacks() :: + {'attribute', anno(), 'optional_callbacks', af_fa_list()}. + +-type af_compile() :: {'attribute', anno(), 'compile', any()}. + +-type af_file() :: {'attribute', anno(), 'file', {string(), anno()}}. + +-type af_record_decl() :: + {'attribute', anno(), 'record', {record_name(), [af_field_decl()]}}. + +-type af_field_decl() :: af_typed_field() | af_field(). + +-type af_typed_field() :: + {'typed_record_field', af_field(), abstract_type()}. + +-type af_field() :: {'record_field', anno(), af_field_name()} + | {'record_field', anno(), af_field_name(), abstract_expr()}. + +-type af_type_decl() :: {'attribute', anno(), type_attr(), + {type_name(), abstract_type(), [af_variable()]}}. + +-type type_attr() :: 'opaque' | 'type'. + +-type af_function_spec() :: {'attribute', anno(), spec_attr(), + {{function_name(), arity()}, + af_function_type_list()}} + | {'attribute', anno(), 'spec', + {{module(), function_name(), arity()}, + af_function_type_list()}}. + +-type spec_attr() :: 'callback' | 'spec'. + +-type af_wild_attribute() :: {'attribute', anno(), atom(), any()}. + +-type af_function_decl() :: + {'function', anno(), function_name(), arity(), af_clause_seq()}. + +-type abstract_expr() :: af_literal() + | af_match(abstract_expr()) + | af_variable() + | af_tuple(abstract_expr()) + | af_nil() + | af_cons(abstract_expr()) + | af_bin(abstract_expr()) + | af_binary_op(abstract_expr()) + | af_unary_op(abstract_expr()) + | af_record_access(abstract_expr()) + | af_record_update(abstract_expr()) + | af_record_index() + | af_record_field_access(abstract_expr()) + | af_map_access(abstract_expr()) + | af_map_update(abstract_expr()) + | af_catch() + | af_local_call() + | af_remote_call() + | af_list_comprehension() + | af_binary_comprehension() + | af_block() + | af_if() + | af_case() + | af_try() + | af_receive() + | af_local_fun() + | af_remote_fun() + | af_fun() + | af_named_fun(). + +-type af_record_update(T) :: {'record', + anno(), + abstract_expr(), + record_name(), + [af_record_field(T)]}. + +-type af_catch() :: {'catch', anno(), abstract_expr()}. + +-type af_local_call() :: {'call', anno(), af_local_function(), af_args()}. + +-type af_remote_call() :: {'call', anno(), af_remote_function(), af_args()}. + +-type af_args() :: [abstract_expr()]. + +-type af_local_function() :: abstract_expr(). + +-type af_remote_function() :: + {'remote', anno(), abstract_expr(), abstract_expr()}. + +-type af_list_comprehension() :: + {'lc', anno(), af_template(), af_qualifier_seq()}. + +-type af_binary_comprehension() :: + {'bc', anno(), af_template(), af_qualifier_seq()}. + +-type af_template() :: abstract_expr(). + +-type af_qualifier_seq() :: [af_qualifier()]. + +-type af_qualifier() :: af_generator() | af_filter(). + +-type af_generator() :: {'generate', anno(), af_pattern(), abstract_expr()} + | {'b_generate', anno(), af_pattern(), abstract_expr()}. + +-type af_filter() :: abstract_expr(). + +-type af_block() :: {'block', anno(), af_body()}. + +-type af_if() :: {'if', anno(), af_clause_seq()}. + +-type af_case() :: {'case', anno(), abstract_expr(), af_clause_seq()}. + +-type af_try() :: {'try', + anno(), + af_body() | [], + af_clause_seq() | [], + af_clause_seq() | [], + af_body() | []}. + +-type af_clause_seq() :: [af_clause(), ...]. + +-type af_receive() :: + {'receive', anno(), af_clause_seq()} + | {'receive', anno(), af_clause_seq(), abstract_expr(), af_body()}. + +-type af_local_fun() :: + {'fun', anno(), {'function', function_name(), arity()}}. + +-type af_remote_fun() :: + {'fun', anno(), {'function', module(), function_name(), arity()}} + | {'fun', anno(), {'function', af_atom(), af_atom(), af_integer()}}. + +-type af_fun() :: {'fun', anno(), {'clauses', af_clause_seq()}}. + +-type af_named_fun() :: {'named_fun', anno(), fun_name(), af_clause_seq()}. + +-type fun_name() :: atom(). + +-type abstract_clause() :: af_clause(). + +-type af_clause() :: + {'clause', anno(), [af_pattern()], af_guard_seq(), af_body()}. + +-type af_body() :: [abstract_expr(), ...]. + +-type af_guard_seq() :: [af_guard()]. + +-type af_guard() :: [af_guard_test(), ...]. + +-type af_guard_test() :: af_literal() + | af_variable() + | af_tuple(af_guard_test()) + | af_nil() + | af_cons(af_guard_test()) + | af_bin(af_guard_test()) + | af_binary_op(af_guard_test()) + | af_unary_op(af_guard_test()) + | af_record_access(af_guard_test()) + | af_record_index() + | af_record_field_access(af_guard_test()) + | af_map_access(abstract_expr()) % FIXME + | af_map_update(abstract_expr()) % FIXME + | af_guard_call() + | af_remote_guard_call(). + +-type af_record_field_access(T) :: + {'record_field', anno(), T, record_name(), af_field_name()}. + +-type af_map_access(T) :: {'map', anno(), [af_map_field(T)]}. + +-type af_map_update(T) :: {'map', anno(), T, [af_map_field(T)]}. + +-type af_map_field(T) :: af_map_field_assoc(T) | af_map_field_exact(T). + +-type af_map_field_assoc(T) :: {'map_field_assoc', anno(), T, T}. + +-type af_map_field_exact(T) :: {'map_field_exact', anno(), T, T}. + +-type af_guard_call() :: {'call', anno(), function_name(), [af_guard_test()]}. + +-type af_remote_guard_call() :: + {'call', anno(), + {'remote', anno(), af_lit_atom('erlang'), af_atom()}, + [af_guard_test()]}. + +-type af_pattern() :: af_literal() + | af_match(af_pattern()) + | af_variable() + | af_tuple(af_pattern()) + | af_nil() + | af_cons(af_pattern()) + | af_bin(af_pattern()) + | af_binary_op(af_pattern()) + | af_unary_op(af_pattern()) + | af_record_access(af_pattern()) + | af_record_index() + | af_map_pattern(). + +-type af_record_index() :: + {'record_index', anno(), record_name(), af_field_name()}. + +-type af_record_access(T) :: + {'record', anno(), record_name(), [af_record_field(T)]}. + +-type af_record_field(T) :: {'record_field', anno(), af_field_name(), T}. + +-type af_map_pattern() :: + {'map', anno(), [af_map_field_exact(abstract_expr)]}. % FIXME? + +-type abstract_type() :: af_annotated_type() + | af_atom() + | af_bitstring_type() + | af_empty_list_type() + | af_fun_type() + | af_integer_range_type() + | af_map_type() + | af_predefined_type() + | af_record_type() + | af_remote_type() + | af_singleton_integer_type() + | af_tuple_type() + | af_type_union() + | af_type_variable() + | af_user_defined_type(). + +-type af_annotated_type() :: + {'ann_type', anno(), [af_anno() | abstract_type()]}. % [Var, Type] + +-type af_anno() :: af_variable(). + +-type af_bitstring_type() :: + {'type', anno(), 'binary', [af_singleton_integer_type()]}. + +-type af_empty_list_type() :: {'type', anno(), 'nil', []}. + +-type af_fun_type() :: {'type', anno(), 'fun', []} + | {'type', anno(), 'fun', [{'type', anno(), 'any'} | + abstract_type()]} + | {'type', anno(), 'fun', af_function_type()}. + +-type af_integer_range_type() :: + {'type', anno(), 'range', [af_singleton_integer_type()]}. + +-type af_map_type() :: {'type', anno(), 'map', 'any'} + | {'type', anno(), 'map', [af_map_pair_type()]}. + +-type af_map_pair_type() :: + {'type', anno(), 'map_field_assoc', [abstract_type()]}. + +-type af_predefined_type() :: + {'type', anno(), type_name(), [abstract_type()]}. + +-type af_record_type() :: + {'type', anno(), 'record', [(Name :: af_atom()) % [Name, T1, ... Tk] + | af_record_field_type()]}. + +-type af_record_field_type() :: + {'type', anno(), 'field_type', [(Name :: af_atom()) | + abstract_type()]}. % [Name, Type] + +-type af_remote_type() :: + {'remote_type', anno(), [(Module :: af_atom()) | + (TypeName :: af_atom()) | + [abstract_type()]]}. % [Module, Name, [T]] + +-type af_tuple_type() :: {'type', anno(), 'tuple', 'any'} + | {'type', anno(), 'tuple', [abstract_type()]}. + +-type af_type_union() :: {'type', anno(), 'union', [abstract_type()]}. + +-type af_type_variable() :: {'var', anno(), atom()}. % except '_' + +-type af_user_defined_type() :: + {'user_type', anno(), type_name(), [abstract_type()]}. + +-type af_function_type_list() :: [af_constrained_function_type() | + af_function_type()]. + +-type af_constrained_function_type() :: + {'type', anno(), 'bounded_fun', [af_function_type() | % [Ft, Fc] + af_function_constraint()]}. + +-type af_function_type() :: + {'type', anno(), 'fun', + [{'type', anno(), 'product', [abstract_type()]} | abstract_type()]}. + +-type af_function_constraint() :: [af_constraint()]. + +-type af_constraint() :: {'type', anno(), 'constraint', + af_lit_atom('is_subtype'), + [af_type_variable() | abstract_type()]}. % [V, T] + +-type af_singleton_integer_type() :: af_integer() + | af_unary_op(af_singleton_integer_type()) + | af_binary_op(af_singleton_integer_type()). + +-type af_literal() :: af_atom() | af_integer() | af_float() | af_string(). + +-type af_atom() :: af_lit_atom(atom()). + +-type af_lit_atom(A) :: {'atom', anno(), A}. + +-type af_integer() :: {'integer', anno(), non_neg_integer()}. + +-type af_float() :: {'float', anno(), float()}. + +-type af_string() :: {'string', anno(), string()}. + +-type af_match(T) :: {'match', anno(), af_pattern(), T}. + +-type af_variable() :: {'var', anno(), atom()}. % | af_anon_variable() + +%-type af_anon_variable() :: {'var', anno(), '_'}. + +-type af_tuple(T) :: {'tuple', anno(), [T]}. + +-type af_nil() :: {'nil', anno()}. + +-type af_cons(T) :: {'cons', anno(), T, T}. + +-type af_bin(T) :: {'bin', anno(), [af_binelement(T)]}. + +-type af_binelement(T) :: {'bin_element', + anno(), + T, + af_binelement_size(), + type_specifier_list()}. + +-type af_binelement_size() :: 'default' | abstract_expr(). + +-type af_binary_op(T) :: {'op', anno(), binary_op(), T, T}. + +-type binary_op() :: '/' | '*' | 'div' | 'rem' | 'band' | 'and' | '+' | '-' + | 'bor' | 'bxor' | 'bsl' | 'bsr' | 'or' | 'xor' | '++' + | '--' | '==' | '/=' | '=<' | '<' | '>=' | '>' | '=:=' + | '=/='. + +-type af_unary_op(T) :: {'op', anno(), unary_op(), T}. + +-type unary_op() :: '+' | '*' | 'bnot' | 'not'. + +%% See also lib/stdlib/{src/erl_bits.erl,include/erl_bits.hrl}. +-type type_specifier_list() :: 'default' | [type_specifier(), ...]. + +-type type_specifier() :: type() + | signedness() + | endianness() + | unit(). + +-type type() :: 'integer' + | 'float' + | 'binary' + | 'bytes' + | 'bitstring' + | 'bits' + | 'utf8' + | 'utf16' + | 'utf32'. + +-type signedness() :: 'signed' | 'unsigned'. + +-type endianness() :: 'big' | 'little' | 'native'. + +-type unit() :: {'unit', 1..256}. + +-type record_name() :: atom(). + +-type af_field_name() :: af_atom(). + +-type function_name() :: atom(). + +-type type_name() :: atom(). + +%% End of Abstract Format %% XXX. To be refined. --type abstract_clause() :: term(). --type abstract_expr() :: term(). --type abstract_form() :: term(). -type error_description() :: term(). -type error_info() :: {erl_anno:line(), module(), error_description()}. -type token() :: erl_scan:token(). @@ -639,14 +1036,8 @@ build_type_spec({Kind,Aa}, {SpecFun, TypeSpecs}) {atom, _, Fun} -> {Fun, find_arity_from_specs(TypeSpecs)}; {{atom,_, Mod}, {atom,_, Fun}} -> - {Mod,Fun,find_arity_from_specs(TypeSpecs)}; - {{atom, _, Fun}, {integer, _, Arity}} -> - %% Old style spec. Allow this for now. - {Fun,Arity}; - {{atom,_, Mod}, {atom, _, Fun}, {integer, _, Arity}} -> - %% Old style spec. Allow this for now. - {Mod,Fun,Arity} - end, + {Mod,Fun,find_arity_from_specs(TypeSpecs)} + end, {attribute,Aa,Kind,{NewSpecFun, TypeSpecs}}. find_arity_from_specs([Spec|_]) -> @@ -795,31 +1186,11 @@ record_fields([{match,_Am,{atom,Aa,A},Expr}|Fields]) -> [{record_field,Aa,{atom,Aa,A},Expr}|record_fields(Fields)]; record_fields([{typed,Expr,TypeInfo}|Fields]) -> [Field] = record_fields([Expr]), - TypeInfo1 = - case Expr of - {match, _, _, _} -> TypeInfo; %% If we have an initializer. - {atom, Aa, _} -> - case has_undefined(TypeInfo) of - false -> - lift_unions(abstract2(undefined, Aa), TypeInfo); - true -> - TypeInfo - end - end, - [{typed_record_field,Field,TypeInfo1}|record_fields(Fields)]; + [{typed_record_field,Field,TypeInfo}|record_fields(Fields)]; record_fields([Other|_Fields]) -> ret_err(?anno(Other), "bad record field"); record_fields([]) -> []. -has_undefined({atom,_,undefined}) -> - true; -has_undefined({ann_type,_,[_,T]}) -> - has_undefined(T); -has_undefined({type,_,union,Ts}) -> - lists:any(fun has_undefined/1, Ts); -has_undefined(_) -> - false. - term(Expr) -> try normalise(Expr) catch _:_R -> ret_err(?anno(Expr), "bad attribute") @@ -1118,33 +1489,16 @@ type_preop_prec('-') -> {600,700}; type_preop_prec('bnot') -> {600,700}; type_preop_prec('#') -> {700,800}. -%%% [Experimental]. The parser just copies the attributes of the -%%% scanner tokens to the abstract format. This design decision has -%%% been hidden to some extent: use set_line() and get_attribute() to -%%% access the second element of (almost all) of the abstract format -%%% tuples. A typical use is to negate line numbers to prevent the -%%% compiler from emitting warnings and errors. The second element can -%%% (of course) be set to any value, but then these functions no -%%% longer apply. To get all present attributes as a property list -%%% get_attributes() should be used. - --compile({nowarn_deprecated_function,{erl_scan,set_attribute,3}}). -set_line(L, F) -> - erl_scan:set_attribute(line, L, F). - --compile({nowarn_deprecated_function,{erl_scan,attributes_info,2}}). -get_attribute(L, Name) -> - erl_scan:attributes_info(L, Name). - --compile({nowarn_deprecated_function,{erl_scan,attributes_info,1}}). -get_attributes(L) -> - erl_scan:attributes_info(L). +-type erl_parse_tree() :: abstract_clause() + | abstract_expr() + | abstract_form() + | abstract_type(). -spec map_anno(Fun, Abstr) -> NewAbstr when Fun :: fun((Anno) -> Anno), Anno :: erl_anno:anno(), - Abstr :: abstract_form() | abstract_expr(), - NewAbstr :: abstract_form() | abstract_expr(). + Abstr :: erl_parse_tree(), + NewAbstr :: erl_parse_tree(). map_anno(F0, Abstr) -> F = fun(A, Acc) -> {F0(A), Acc} end, @@ -1157,8 +1511,8 @@ map_anno(F0, Abstr) -> Acc0 :: term(), AccIn :: term(), AccOut :: term(), - Abstr :: abstract_form() | abstract_expr(), - NewAbstr :: abstract_form() | abstract_expr(). + Abstr :: erl_parse_tree(), + NewAbstr :: erl_parse_tree(). fold_anno(F0, Acc0, Abstr) -> F = fun(A, Acc) -> {A, F0(A, Acc)} end, @@ -1172,26 +1526,26 @@ fold_anno(F0, Acc0, Abstr) -> Acc1 :: term(), AccIn :: term(), AccOut :: term(), - Abstr :: abstract_form() | abstract_expr(), - NewAbstr :: abstract_form() | abstract_expr(). + Abstr :: erl_parse_tree(), + NewAbstr :: erl_parse_tree(). mapfold_anno(F, Acc0, Abstr) -> modify_anno1(Abstr, Acc0, F). -spec new_anno(Term) -> Abstr when Term :: term(), - Abstr :: abstract_form() | abstract_expr(). + Abstr :: erl_parse_tree(). new_anno(Term) -> map_anno(fun erl_anno:new/1, Term). -spec anno_to_term(Abstr) -> term() when - Abstr :: abstract_form() | abstract_expr(). + Abstr :: erl_parse_tree(). anno_to_term(Abstract) -> map_anno(fun erl_anno:to_term/1, Abstract). --spec anno_from_term(Term) -> abstract_form() | abstract_expr() when +-spec anno_from_term(Term) -> erl_parse_tree() when Term :: term(). anno_from_term(Term) -> diff --git a/lib/stdlib/src/erl_scan.erl b/lib/stdlib/src/erl_scan.erl index d2f53816b8..47223b129c 100644 --- a/lib/stdlib/src/erl_scan.erl +++ b/lib/stdlib/src/erl_scan.erl @@ -52,25 +52,15 @@ %%% External exports -export([string/1,string/2,string/3,tokens/3,tokens/4, - format_error/1,reserved_word/1, - token_info/1,token_info/2, - attributes_info/1,attributes_info/2,set_attribute/3]). + format_error/1,reserved_word/1]). -export([column/1,end_location/1,line/1,location/1,text/1, category/1,symbol/1]). --deprecated([{attributes_info, 1, next_major_release}, - {attributes_info, 2, next_major_release}, - {set_attribute, 3, next_major_release}, - {token_info, 1, next_major_release}, - {token_info, 2, next_major_release}]). - %%% Private -export([continuation_location/1]). -export_type([error_info/0, - line/0, - location/0, options/0, return_cont/0, token/0, @@ -85,29 +75,18 @@ -define(ALINE(L), is_integer(L)). -define(STRING(S), is_list(S)). -define(RESWORDFUN(F), is_function(F, 1)). --define(SETATTRFUN(F), is_function(F, 1)). -type category() :: atom(). --type column() :: pos_integer(). % Deprecated --type line() :: integer(). % Deprecated --type location() :: line() | {line(),column()}. % Deprecated -type resword_fun() :: fun((atom()) -> boolean()). -type option() :: 'return' | 'return_white_spaces' | 'return_comments' | 'text' | {'reserved_word_fun', resword_fun()}. -type options() :: option() | [option()]. -type symbol() :: atom() | float() | integer() | string(). --type info_line() :: integer() | term(). --type attributes_data() - :: [{'column', column()} | {'line', info_line()} | {'text', string()}] - | {line(), column()}. -%% The fact that {line(),column()} is a possible attributes() type -%% is hidden. --type attributes() :: line() | attributes_data(). --type token() :: {category(), attributes(), symbol()} - | {category(), attributes()}. +-type token() :: {category(), Anno :: erl_anno:anno(), symbol()} + | {category(), Anno :: erl_anno:anno()}. -type tokens() :: [token()]. -type error_description() :: term(). --type error_info() :: {location(), module(), error_description()}. +-type error_info() :: {erl_anno:location(), module(), error_description()}. %%% Local record. -record(erl_scan, @@ -136,8 +115,8 @@ format_error(Other) -> String :: string(), Return :: {'ok', Tokens :: tokens(), EndLocation} | {'error', ErrorInfo :: error_info(), ErrorLocation}, - EndLocation :: location(), - ErrorLocation :: location(). + EndLocation :: erl_anno:location(), + ErrorLocation :: erl_anno:location(). string(String) -> string(String, 1, []). @@ -145,9 +124,9 @@ string(String) -> String :: string(), Return :: {'ok', Tokens :: tokens(), EndLocation} | {'error', ErrorInfo :: error_info(), ErrorLocation}, - StartLocation :: location(), - EndLocation :: location(), - ErrorLocation :: location(). + StartLocation :: erl_anno:location(), + EndLocation :: erl_anno:location(), + ErrorLocation :: erl_anno:location(). string(String, StartLocation) -> string(String, StartLocation, []). @@ -156,9 +135,9 @@ string(String, StartLocation) -> Options :: options(), Return :: {'ok', Tokens :: tokens(), EndLocation} | {'error', ErrorInfo :: error_info(), ErrorLocation}, - StartLocation :: location(), - EndLocation :: location(), - ErrorLocation :: location(). + StartLocation :: erl_anno:location(), + EndLocation :: erl_anno:location(), + ErrorLocation :: erl_anno:location(). string(String, Line, Options) when ?STRING(String), ?ALINE(Line) -> string1(String, options(Options), Line, no_col, []); string(String, {Line,Column}, Options) when ?STRING(String), @@ -167,20 +146,23 @@ string(String, {Line,Column}, Options) when ?STRING(String), string1(String, options(Options), Line, Column, []). -type char_spec() :: string() | 'eof'. --type cont_fun() :: fun((char_spec(), #erl_scan{}, line(), column(), +-type cont_fun() :: fun((char_spec(), #erl_scan{}, + erl_anno:line(), erl_anno:column(), tokens(), any()) -> any()). -opaque return_cont() :: {erl_scan_continuation, - string(), column(), tokens(), line(), + string(), erl_anno:column(), tokens(), + erl_anno:line(), #erl_scan{}, any(), cont_fun()}. --type tokens_result() :: {'ok', Tokens :: tokens(), EndLocation :: location()} - | {'eof', EndLocation :: location()} +-type tokens_result() :: {'ok', Tokens :: tokens(), + EndLocation :: erl_anno:location()} + | {'eof', EndLocation :: erl_anno:location()} | {'error', ErrorInfo :: error_info(), - EndLocation :: location()}. + EndLocation :: erl_anno:location()}. -spec tokens(Continuation, CharSpec, StartLocation) -> Return when Continuation :: return_cont() | [], CharSpec :: char_spec(), - StartLocation :: location(), + StartLocation :: erl_anno:location(), Return :: {'done',Result :: tokens_result(),LeftOverChars :: char_spec()} | {'more', Continuation1 :: return_cont()}. tokens(Cont, CharSpec, StartLocation) -> @@ -189,7 +171,7 @@ tokens(Cont, CharSpec, StartLocation) -> -spec tokens(Continuation, CharSpec, StartLocation, Options) -> Return when Continuation :: return_cont() | [], CharSpec :: char_spec(), - StartLocation :: location(), + StartLocation :: erl_anno:location(), Options :: options(), Return :: {'done',Result :: tokens_result(),LeftOverChars :: char_spec()} | {'more', Continuation1 :: return_cont()}. @@ -257,155 +239,6 @@ symbol({_Category,_Anno,Symbol}) -> symbol(T) -> erlang:error(badarg, [T]). --type attribute_item() :: 'column' | 'length' | 'line' - | 'location' | 'text'. --type info_location() :: location() | term(). --type attribute_info() :: {'column', column()}| {'length', pos_integer()} - | {'line', info_line()} - | {'location', info_location()} - | {'text', string()}. --type token_item() :: 'category' | 'symbol' | attribute_item(). --type token_info() :: {'category', category()} | {'symbol', symbol()} - | attribute_info(). - --spec token_info(Token) -> TokenInfo when - Token :: token(), - TokenInfo :: [TokenInfoTuple :: token_info()]. -token_info(Token) -> - Items = [category,column,length,line,symbol,text], % undefined order - token_info(Token, Items). - --spec token_info(Token, TokenItem) -> TokenInfoTuple | 'undefined' when - Token :: token(), - TokenItem :: token_item(), - TokenInfoTuple :: token_info(); - (Token, TokenItems) -> TokenInfo when - Token :: token(), - TokenItems :: [TokenItem :: token_item()], - TokenInfo :: [TokenInfoTuple :: token_info()]. -token_info(_Token, []) -> - []; -token_info(Token, [Item|Items]) when is_atom(Item) -> - case token_info(Token, Item) of - undefined -> - token_info(Token, Items); - TokenInfo when is_tuple(TokenInfo) -> - [TokenInfo|token_info(Token, Items)] - end; -token_info({Category,_Attrs}, category=Item) -> - {Item,Category}; -token_info({Category,_Attrs,_Symbol}, category=Item) -> - {Item,Category}; -token_info({Category,_Attrs}, symbol=Item) -> - {Item,Category}; -token_info({_Category,_Attrs,Symbol}, symbol=Item) -> - {Item,Symbol}; -token_info({_Category,Attrs}, Item) -> - attributes_info(Attrs, Item); -token_info({_Category,Attrs,_Symbol}, Item) -> - attributes_info(Attrs, Item). - --spec attributes_info(Attributes) -> AttributesInfo when - Attributes :: attributes(), - AttributesInfo :: [AttributeInfoTuple :: attribute_info()]. -attributes_info(Attributes) -> - Items = [column,length,line,text], % undefined order - attributes_info(Attributes, Items). - --spec attributes_info - (Attributes, AttributeItem) -> AttributeInfoTuple | 'undefined' when - Attributes :: attributes(), - AttributeItem :: attribute_item(), - AttributeInfoTuple :: attribute_info(); - (Attributes, AttributeItems) -> AttributeInfo when - Attributes :: attributes(), - AttributeItems :: [AttributeItem :: attribute_item()], - AttributeInfo :: [AttributeInfoTuple :: attribute_info()]. -attributes_info(_Attrs, []) -> - []; -attributes_info(Attrs, [A|As]) when is_atom(A) -> - case attributes_info(Attrs, A) of - undefined -> - attributes_info(Attrs, As); - AttributeInfo when is_tuple(AttributeInfo) -> - [AttributeInfo|attributes_info(Attrs, As)] - end; -attributes_info({Line,Column}, column=Item) when ?ALINE(Line), - ?COLUMN(Column) -> - {Item,Column}; -attributes_info(Line, column) when ?ALINE(Line) -> - undefined; -attributes_info(Attrs, column=Item) -> - case attr_info(Attrs, Item) of - undefined -> - case erl_anno:column(Attrs) of - undefined -> - undefined; - Column -> - {Item,Column} - end; - T -> - T - end; -attributes_info(Attrs, length=Item) -> - case attributes_info(Attrs, text) of - undefined -> - undefined; - {text,Text} -> - {Item,length(Text)} - end; -attributes_info(Line, line=Item) when ?ALINE(Line) -> - {Item,Line}; -attributes_info({Line,Column}, line=Item) when ?ALINE(Line), - ?COLUMN(Column) -> - {Item,Line}; -attributes_info(Attrs, line=Item) -> - case attr_info(Attrs, Item) of - undefined -> - case attr_info(Attrs, location) of - {location,{Line,_Column}} -> - {Item,Line}; - {location,Line} -> - {Item,Line}; - undefined -> - undefined - end; - T -> - T - end; -attributes_info({Line,Column}=Location, location=Item) when ?ALINE(Line), - ?COLUMN(Column) -> - {Item,Location}; -attributes_info(Line, location=Item) when ?ALINE(Line) -> - {Item,Line}; -attributes_info(Attrs, location=Item) -> - {line,Line} = attributes_info(Attrs, line), - case attributes_info(Attrs, column) of - undefined -> - %% If set_attribute() has assigned a term such as {17,42} - %% to 'line', then Line will look like {Line,Column}. One - %% should not use 'location' but 'line' and 'column' in - %% such special cases. - {Item,Line}; - {column,Column} -> - {Item,{Line,Column}} - end; -attributes_info({Line,Column}, text) when ?ALINE(Line), ?COLUMN(Column) -> - undefined; -attributes_info(Line, text) when ?ALINE(Line) -> - undefined; -attributes_info(Attrs, text=Item) -> - attr_info(Attrs, Item); -attributes_info(T1, T2) -> - erlang:error(badarg, [T1,T2]). - --spec set_attribute(AttributeItem, Attributes, SetAttributeFun) -> Attributes when - AttributeItem :: 'line', - Attributes :: attributes(), - SetAttributeFun :: fun((info_line()) -> info_line()). -set_attribute(Tag, Attributes, Fun) when ?SETATTRFUN(Fun) -> - set_attr(Tag, Attributes, Fun). - %%% %%% Local functions %%% @@ -471,62 +304,6 @@ expand_opt(return, Os) -> expand_opt(O, Os) -> [O|Os]. -attr_info(Attrs, Item) -> - try lists:keyfind(Item, 1, Attrs) of - {_Item, _Value} = T -> - T; - false -> - undefined - catch - _:_ -> - erlang:error(badarg, [Attrs, Item]) - end. - --spec set_attr('line', attributes(), fun((line()) -> line())) -> attributes(). - -set_attr(line, Line, Fun) when ?ALINE(Line) -> - Ln = Fun(Line), - if - ?ALINE(Ln) -> - Ln; - true -> - [{line,Ln}] - end; -set_attr(line, {Line,Column}, Fun) when ?ALINE(Line), ?COLUMN(Column) -> - Ln = Fun(Line), - if - ?ALINE(Ln) -> - {Ln,Column}; - true -> - [{line,Ln},{column,Column}] - end; -set_attr(line=Tag, Attrs, Fun) when is_list(Attrs) -> - case lists:keyfind(Tag, 1, Attrs) of - {line,Line} -> - case lists:keyreplace(Tag, 1, Attrs, {line,Fun(Line)}) of - [{line,Ln}] when ?ALINE(Ln) -> - Ln; - As -> - As - end; - false -> - {location, Location} = lists:keyfind(location, 1, Attrs), - Ln = case Location of - {Line,Column} when ?ALINE(Line), ?COLUMN(Column) -> - {Fun(Line),Column}; - _ -> - Fun(Location) - end, - case lists:keyreplace(location, 1, Attrs, {location,Ln}) of - [{location,Ln}] when ?ALINE(Ln) -> - Ln; - As -> - As - end - end; -set_attr(T1, T2, T3) -> - erlang:error(badarg, [T1,T2,T3]). - tokens1(Cs, St, Line, Col, Toks, Fun, Any) when ?STRING(Cs); Cs =:= eof -> case Fun(Cs, St, Line, Col, Toks, Any) of {more,{Cs0,Ncol,Ntoks,Nline,Nany,Nfun}} -> diff --git a/lib/stdlib/src/escript.erl b/lib/stdlib/src/escript.erl index 41b49f4a86..b8ce311c35 100644 --- a/lib/stdlib/src/escript.erl +++ b/lib/stdlib/src/escript.erl @@ -38,7 +38,7 @@ -record(state, {file :: file:filename(), module :: module(), forms_or_bin, - source :: source(), + source :: source() | 'undefined', n_errors :: non_neg_integer(), mode :: mode(), exports_main :: boolean(), @@ -49,9 +49,9 @@ -type emu_args() :: string(). -record(sections, {type, - shebang :: shebang(), - comment :: comment(), - emu_args :: emu_args(), + shebang :: shebang() | 'undefined', + comment :: comment() | 'undefined', + emu_args :: emu_args() | 'undefined', body}). -record(extract_options, {compile_source}). diff --git a/lib/stdlib/src/ets.erl b/lib/stdlib/src/ets.erl index 847def2fd8..1fca3624dc 100644 --- a/lib/stdlib/src/ets.erl +++ b/lib/stdlib/src/ets.erl @@ -146,7 +146,7 @@ info(_) -> Tab :: tab(), Item :: compressed | fixed | heir | keypos | memory | name | named_table | node | owner | protection - | safe_fixed | size | stats | type + | safe_fixed | safe_fixed_monotonic_time | size | stats | type | write_concurrency | read_concurrency, Value :: term(). diff --git a/lib/stdlib/src/file_sorter.erl b/lib/stdlib/src/file_sorter.erl index 47adb133b0..3aeaff8dc4 100644 --- a/lib/stdlib/src/file_sorter.erl +++ b/lib/stdlib/src/file_sorter.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2013. All Rights Reserved. +%% 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. @@ -28,6 +28,8 @@ check/1, check/2, keycheck/2, keycheck/3]). +-dialyzer(no_improper_lists). + -include_lib("kernel/include/file.hrl"). -define(CHUNKSIZE, 16384). @@ -305,7 +307,6 @@ options(Option) -> options([{format, Format} | L], Opts) when Format =:= binary; Format =:= term; - is_function(Format), is_function(Format, 1) -> options(L, Opts#opts{format = Format}); options([{format, binary_term} | L], Opts) -> @@ -324,7 +325,7 @@ options([{tmpdir, Dir} | L], Opts) -> FileName -> options(L, Opts#opts{tmpdir = {dir, FileName}}) end; -options([{order, Fun} | L], Opts) when is_function(Fun), is_function(Fun, 2) -> +options([{order, Fun} | L], Opts) when is_function(Fun, 2) -> options(L, Opts#opts{order = Fun}); options([{order, Order} | L], Opts) when Order =:= ascending; Order =:= descending -> @@ -409,7 +410,7 @@ merge_terms_fun(RFun) -> case RFun(read) of end_of_input -> eof; - {Objs, NRFun} when is_function(NRFun), is_function(NRFun, 1) -> + {Objs, NRFun} when is_function(NRFun, 1) -> {_, [], Ts, _} = fun_objs(Objs, [], 0, ?MAXSIZE, I, W), {{I, Ts, ?CHUNKSIZE}, merge_terms_fun(NRFun)}; Error -> @@ -425,13 +426,12 @@ merge_bins_fun(FileName) -> Fun(A) end. -wrap_output_terms(term, OutFun, _Z) when is_function(OutFun), - is_function(OutFun, 1) -> +wrap_output_terms(term, OutFun, _Z) when is_function(OutFun, 1) -> {fun_wterms(OutFun), true}; wrap_output_terms(term, File, Z) when File =/= undefined -> {file_wterms(name, File, Z++[write]), false}; wrap_output_terms(_Format, Output, _Z) -> - {Output, is_function(Output) and is_function(Output, 1)}. + {Output, is_function(Output, 1)}. binary_term_fun() -> fun binary_to_term/1. @@ -1309,8 +1309,7 @@ infun(W) -> {end_of_input, W1}; {end_of_input, Value} -> {end_of_input, W1#w{inout_value = {value, Value}}}; - {Objs, NFun} when is_function(NFun), - is_function(NFun, 1), + {Objs, NFun} when is_function(NFun, 1), is_list(Objs) -> {cont, W#w{in = NFun}, Objs}; Error -> @@ -1333,7 +1332,7 @@ outfun(A, W) -> try (W#w.out)(A) of Reply when A =:= close -> Reply; - NF when is_function(NF), is_function(NF, 1) -> + NF when is_function(NF, 1) -> W#w{out = NF}; Error -> error(Error, W1) @@ -1358,7 +1357,7 @@ is_keyposs([Bad | _]) -> is_keyposs(Bad) -> {badarg, Bad}. -is_input(Fun) when is_function(Fun), is_function(Fun, 1) -> +is_input(Fun) when is_function(Fun, 1) -> {true, Fun}; is_input(Files) -> is_files(Files). @@ -1378,7 +1377,7 @@ is_files([], L) -> is_files(Bad, _L) -> {badarg, Bad}. -maybe_output(Fun) when is_function(Fun), is_function(Fun, 1) -> +maybe_output(Fun) when is_function(Fun, 1) -> {true, Fun}; maybe_output(File) -> case read_file_info(File) of @@ -1587,7 +1586,6 @@ fun_rterms(InFun) -> (read) -> case InFun(read) of {Ts, NInFun} when is_list(Ts), - is_function(NInFun), is_function(NInFun, 1) -> {to_bin(Ts, []), fun_rterms(NInFun)}; Else -> @@ -1600,7 +1598,7 @@ fun_wterms(OutFun) -> OutFun(close); (L) -> case OutFun(wterms_arg(L)) of - NOutFun when is_function(NOutFun), is_function(NOutFun, 1) -> + NOutFun when is_function(NOutFun, 1) -> fun_wterms(NOutFun); Else -> Else diff --git a/lib/stdlib/src/io.erl b/lib/stdlib/src/io.erl index 284f2e5a2b..f510f61e9f 100644 --- a/lib/stdlib/src/io.erl +++ b/lib/stdlib/src/io.erl @@ -444,7 +444,7 @@ scan_erl_form(Io, Prompt, Pos0, Options) -> %% Parsing Erlang code. -type parse_ret() :: {'ok', - ExprList :: erl_parse:abstract_expr(), + ExprList :: [erl_parse:abstract_expr()], EndLocation :: location()} | {'eof', EndLocation :: location()} | {'error', @@ -631,41 +631,20 @@ io_requests(Pid, [], [Rs|Cont], Tail) -> io_requests(_Pid, [], [], _Tail) -> {false,[]}. - -bc_req(Pid,{Op,Enc,Param},MaybeConvert) -> - case net_kernel:dflag_unicode_io(Pid) of - true -> - {false,{Op,Enc,Param}}; - false -> - {MaybeConvert,{Op,Param}} - end; -bc_req(Pid,{Op,Enc,P,F},MaybeConvert) -> - case net_kernel:dflag_unicode_io(Pid) of - true -> - {false,{Op,Enc,P,F}}; - false -> - {MaybeConvert,{Op,P,F}} - end; -bc_req(Pid, {Op,Enc,M,F,A},MaybeConvert) -> +bc_req(Pid, Req0, MaybeConvert) -> case net_kernel:dflag_unicode_io(Pid) of true -> - {false,{Op,Enc,M,F,A}}; + %% The most common case. A modern i/o server. + {false,Req0}; false -> - {MaybeConvert,{Op,M,F,A}} - end; -bc_req(Pid, {Op,Enc,P,M,F,A},MaybeConvert) -> - case net_kernel:dflag_unicode_io(Pid) of - true -> - {false,{Op,Enc,P,M,F,A}}; - false -> - {MaybeConvert,{Op,P,M,F,A}} - end; -bc_req(Pid,{Op,Enc},MaybeConvert) -> - case net_kernel:dflag_unicode_io(Pid) of - true -> - {false,{Op, Enc}}; - false -> - {MaybeConvert,Op} + %% Backward compatibility only. Unlikely to ever happen. + case tuple_to_list(Req0) of + [Op,_Enc] -> + {MaybeConvert,Op}; + [Op,_Enc|T] -> + Req = list_to_tuple([Op|T]), + {MaybeConvert,Req} + end end. io_request(Pid, {write,Term}) -> diff --git a/lib/stdlib/src/lists.erl b/lib/stdlib/src/lists.erl index 62b6ca8a21..2b4472cdf7 100644 --- a/lib/stdlib/src/lists.erl +++ b/lib/stdlib/src/lists.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. 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. @@ -2267,6 +2267,8 @@ ukeysplit_2(I, Y, EY, [Z | L], R) -> ukeysplit_2(_I, Y, _EY, [], R) -> [Y | R]. +-dialyzer({no_improper_lists, ukeymergel/3}). + ukeymergel(I, [T1, [H2 | T2], [H3 | T3] | L], Acc) -> %% The fourth argument, [H2 | H3] (=HdM), may confuse type %% checkers. Its purpose is to ensure that the tests H2 == HdM diff --git a/lib/stdlib/src/ms_transform.erl b/lib/stdlib/src/ms_transform.erl index b67b6f75d7..24b5fde1db 100644 --- a/lib/stdlib/src/ms_transform.erl +++ b/lib/stdlib/src/ms_transform.erl @@ -307,15 +307,18 @@ cleanup_filename({Old,OldRec,OldWarnings}) -> add_record_definition({Name,FieldList}) -> {KeyList,_} = lists:foldl( - fun({record_field,_,{atom,Line0,FieldName}},{L,C}) -> - {[{FieldName,C,{atom,Line0,undefined}}|L],C+1}; - ({record_field,_,{atom,_,FieldName},Def},{L,C}) -> - {[{FieldName,C,Def}|L],C+1} - end, + fun(F, {L,C}) -> {[record_field(F, C)|L],C+1} end, {[],2}, FieldList), put_records([{Name,KeyList}|get_records()]). +record_field({record_field,_,{atom,Line0,FieldName}}, C) -> + {FieldName,C,{atom,Line0,undefined}}; +record_field({record_field,_,{atom,_,FieldName},Def}, C) -> + {FieldName,C,Def}; +record_field({typed_record_field,Field,_Type}, C) -> + record_field(Field, C). + forms([F0|Fs0]) -> F1 = form(F0), Fs1 = forms(Fs0), diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index 2d77888512..0dc2626ae8 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2015. 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. @@ -23,6 +23,8 @@ %%---------------------------------------------------------------------- +-dialyzer({no_match, obsolete/3}). + -type tag() :: 'deprecated' | 'removed'. %% | 'experimental'. -type mfas() :: mfa() | {atom(), atom(), [byte()]}. -type release() :: string(). @@ -586,49 +588,40 @@ obsolete_1(asn1rt, utf8_list_to_binary, 1) -> %% Added in OTP 18. obsolete_1(core_lib, get_anno, 1) -> - {deprecated,{cerl,get_ann,1}}; + {removed,{cerl,get_ann,1},"19"}; obsolete_1(core_lib, set_anno, 2) -> - {deprecated,{cerl,set_ann,2}}; + {removed,{cerl,set_ann,2},"19"}; obsolete_1(core_lib, is_literal, 1) -> - {deprecated,{cerl,is_literal,1}}; + {removed,{cerl,is_literal,1},"19"}; obsolete_1(core_lib, is_literal_list, 1) -> - {deprecated,"deprecated; use lists:all(fun cerl:is_literal/1, L)" + {removed,"removed; use lists:all(fun cerl:is_literal/1, L)" " instead"}; obsolete_1(core_lib, literal_value, 1) -> - {deprecated,{core_lib,concrete,1}}; + {removed,{core_lib,concrete,1},"19"}; obsolete_1(erl_scan, set_attribute, 3) -> - {deprecated, - "deprecated (will be removed in OTP 19); use erl_anno:set_line/2 instead"}; + {removed,{erl_anno,set_line,2},"19.0"}; obsolete_1(erl_scan, attributes_info, 1) -> - {deprecated, - "deprecated (will be removed in OTP 19); use " + {removed,"removed in 19.0; use " "erl_anno:{column,line,location,text}/1 instead"}; obsolete_1(erl_scan, attributes_info, 2) -> - {deprecated, - "deprecated (will be removed in OTP 19); use " + {removed,"removed in 19.0; use " "erl_anno:{column,line,location,text}/1 instead"}; obsolete_1(erl_scan, token_info, 1) -> - {deprecated, - "deprecated (will be removed in OTP 19); use " + {removed,"removed in 19.0; use " "erl_scan:{category,column,line,location,symbol,text}/1 instead"}; obsolete_1(erl_scan, token_info, 2) -> - {deprecated, - "deprecated (will be removed in OTP 19); use " + {removed,"removed in 19.0; use " "erl_scan:{category,column,line,location,symbol,text}/1 instead"}; obsolete_1(erl_parse, set_line, 2) -> - {deprecated, - "deprecated (will be removed in OTP 19); use erl_anno:set_line/2 instead"}; + {removed,{erl_anno,set_line,2},"19.0"}; obsolete_1(erl_parse, get_attributes, 1) -> - {deprecated, - "deprecated (will be removed in OTP 19); use " + {removed,"removed in 19.0; use " "erl_anno:{column,line,location,text}/1 instead"}; obsolete_1(erl_parse, get_attribute, 2) -> - {deprecated, - "deprecated (will be removed in OTP 19); use " + {removed,"removed in 19.0; use " "erl_anno:{column,line,location,text}/1 instead"}; obsolete_1(erl_lint, modify_line, 2) -> - {deprecated, - "deprecated (will be removed in OTP 19); use erl_parse:map_anno/2 instead"}; + {removed,{erl_parse,map_anno,2},"19.0"}; obsolete_1(ssl, negotiated_next_protocol, 1) -> {deprecated,{ssl,negotiated_protocol,1}}; @@ -648,6 +641,17 @@ obsolete_1(httpd_conf, is_file, 1) -> 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(overload, _, _) -> + {deprecated, "deprecated; will be removed in OTP 19"}; + obsolete_1(_, _, _) -> no. @@ -695,29 +699,29 @@ 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()}. +-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"}; + {deprecated=Tag,{_,_,_}=Replacement} -> + {Tag,Replacement,"in a future release"}; {_,String}=Ret when is_list(String) -> Ret; -%% {_,_,_}=Ret -> -%% Ret; + {_,_,_}=Ret -> + Ret; no -> no end. obsolete_type_1(erl_scan,column,0) -> - {deprecated, - "deprecated (will be removed in OTP 19); use erl_anno:column() instead"}; + {removed,{erl_anno,column,0},"19.0"}; obsolete_type_1(erl_scan,line,0) -> - {deprecated, - "deprecated (will be removed in OTP 19); use erl_anno:line() instead"}; + {removed,{erl_anno,line,0},"19.0"}; obsolete_type_1(erl_scan,location,0) -> - {deprecated, - "deprecated (will be removed in OTP 19); use erl_anno:location() instead"}; + {removed,{erl_anno,location,0},"19.0"}; obsolete_type_1(_,_,_) -> no. diff --git a/lib/stdlib/src/qlc.erl b/lib/stdlib/src/qlc.erl index 3ba3a88038..b396ba7057 100644 --- a/lib/stdlib/src/qlc.erl +++ b/lib/stdlib/src/qlc.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2015. All Rights Reserved. +%% Copyright Ericsson AB 2004-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. @@ -51,6 +51,8 @@ -export([template_state/0, aux_name/3, name_suffix/2, vars/1, var_ufold/2, var_fold/3, all_selections/1]). +-dialyzer(no_improper_lists). + %% When cache=list lists bigger than ?MAX_LIST_SIZE bytes are put on %% file. Also used when merge join finds big equivalence classes. -define(MAX_LIST_SIZE, 512*1024). @@ -808,21 +810,21 @@ options(Options0, [Key | Keys], L) when is_list(Options0) -> {ok, U}; {pre_fun, U=undefined} -> {ok, U}; - {info_fun, Fun} when is_function(Fun), is_function(Fun, 1) -> + {info_fun, Fun} when is_function(Fun, 1) -> {ok, Fun}; - {pre_fun, Fun} when is_function(Fun), is_function(Fun, 1) -> + {pre_fun, Fun} when is_function(Fun, 1) -> {ok, Fun}; - {post_fun, Fun} when is_function(Fun), is_function(Fun, 0) -> + {post_fun, Fun} when is_function(Fun, 0) -> {ok, Fun}; - {lookup_fun, Fun} when is_function(Fun), is_function(Fun, 2) -> + {lookup_fun, Fun} when is_function(Fun, 2) -> {ok, Fun}; {max_lookup, Max} when is_integer(Max), Max >= 0 -> {ok, Max}; {max_lookup, infinity} -> {ok, -1}; - {format_fun, Fun} when is_function(Fun), is_function(Fun, 1) -> + {format_fun, Fun} when is_function(Fun, 1) -> {ok, Fun}; - {parent_fun, Fun} when is_function(Fun), is_function(Fun, 0) -> + {parent_fun, Fun} when is_function(Fun, 0) -> {ok, Fun}; {key_equality, KE='=='} -> {ok, KE}; @@ -885,7 +887,7 @@ options(Options0, [Key | Keys], L) when is_list(Options0) -> {depth, Depth} when Depth =:= infinity; is_integer(Depth), Depth >= 0 -> {ok, Depth}; - {order, Order} when is_function(Order), is_function(Order, 2); + {order, Order} when is_function(Order, 2); (Order =:= ascending); (Order =:= descending) -> {ok, Order}; diff --git a/lib/stdlib/src/qlc_pt.erl b/lib/stdlib/src/qlc_pt.erl index 9577d17a85..e4b9768b12 100644 --- a/lib/stdlib/src/qlc_pt.erl +++ b/lib/stdlib/src/qlc_pt.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2015. All Rights Reserved. +%% Copyright Ericsson AB 2004-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. @@ -200,7 +200,7 @@ exclude_integers_from_unique_line_numbers(Forms, NodeInfo) -> find_integers(Forms) -> F = fun(A) -> - Fs1 = erl_parse:map_anno(fun(_) -> A end, Forms), + Fs1 = map_anno(fun(_) -> A end, Forms), ordsets:from_list(integers(Fs1, [])) end, ordsets:to_list(ordsets:intersection(F(anno0()), F(anno1()))). @@ -319,13 +319,13 @@ badarg(Forms, State) -> E0. lc_nodes(E, NodeInfo) -> - erl_parse:map_anno(fun(Anno) -> - N = erl_anno:line(Anno), - [{N, Data}] = ets:lookup(NodeInfo, N), - NData = Data#{inside_lc => true}, - true = ets:insert(NodeInfo, {N, NData}), - Anno - end, E). + map_anno(fun(Anno) -> + N = erl_anno:line(Anno), + [{N, Data}] = ets:lookup(NodeInfo, N), + NData = Data#{inside_lc => true}, + true = ets:insert(NodeInfo, {N, NData}), + Anno + end, E). used_genvar_messages(MsL, S) -> [{File,[{Loc,?APIMOD,{used_generator_variable,V}}]} @@ -416,7 +416,7 @@ intro_anno(LC, Where, QId, NodeInfo) -> true = ets:insert(NodeInfo, {Location,Data}), Anno end, - erl_parse:map_anno(Fun, save_anno(LC, NodeInfo)). + map_anno(Fun, save_anno(LC, NodeInfo)). compile_errors(FormsNoShadows) -> case compile_forms(FormsNoShadows, []) of @@ -1650,7 +1650,7 @@ reset_anno(T) -> set_anno(T, anno0()). set_anno(T, A) -> - erl_parse:map_anno(fun(_L) -> A end, T). + map_anno(fun(_L) -> A end, T). -record(fstate, {state, bind_fun, imported}). @@ -1914,9 +1914,9 @@ expand_pattern_records(P, State) -> expand_expr_records(E, State) -> RecordDefs = State#state.records, A = anno1(), - Forms = RecordDefs ++ [{function,A,foo,0,[{clause,A,[],[],[pe(E)]}]}], - [{function,_,foo,0,[{clause,_,[],[],[NE]}]}] = - erl_expand_records:module(Forms, [no_strict_record_tests]), + Forms0 = RecordDefs ++ [{function,A,foo,0,[{clause,A,[],[],[pe(E)]}]}], + Forms = erl_expand_records:module(Forms0, [no_strict_record_tests]), + {function,_,foo,0,[{clause,_,[],[],[NE]}]} = lists:last(Forms), NE. %% Partial evaluation. @@ -2609,7 +2609,7 @@ save_anno(Abstr, NodeInfo) -> true = ets:insert(NodeInfo, Data), erl_anno:new(N) end, - erl_parse:map_anno(F, Abstr). + map_anno(F, Abstr). next_slot(T) -> I = ets:update_counter(T, var_n, 1), @@ -2633,7 +2633,7 @@ restore_anno(Abstr, NodeInfo) -> Anno end end, - erl_parse:map_anno(F, Abstr). + map_anno(F, Abstr). restore_loc(Location, #state{node_info = NodeInfo}) -> case ets:lookup(NodeInfo, Location) of @@ -2872,6 +2872,14 @@ var_mapfold(F, A0, [E0 | Es0]) -> var_mapfold(_F, A, E) -> {E, A}. +map_anno(F, AbstrList) when is_list(AbstrList) -> + [map_anno1(F, Abstr) || Abstr <- AbstrList]; +map_anno(F, Abstr) -> + map_anno1(F, Abstr). + +map_anno1(F, Abstr) -> + erl_parse:map_anno(F, Abstr). + family_list(L) -> sofs:to_external(family(L)). diff --git a/lib/stdlib/src/rand.erl b/lib/stdlib/src/rand.erl index dc060e82d9..d455abf7b0 100644 --- a/lib/stdlib/src/rand.erl +++ b/lib/stdlib/src/rand.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2015. All Rights Reserved. +%% Copyright Ericsson AB 2015-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. @@ -256,6 +256,8 @@ exs64_uniform(Max, {Alg, R}) -> %% ===================================================================== -type exsplus_state() :: nonempty_improper_list(uint58(), uint58()). +-dialyzer({no_improper_lists, exsplus_seed/1}). + exsplus_seed({A1, A2, A3}) -> {_, R1} = exsplus_next([(((A1 * 4294967197) + 1) band ?UINT58MASK)| (((A2 * 4294967231) + 1) band ?UINT58MASK)]), @@ -263,6 +265,8 @@ exsplus_seed({A1, A2, A3}) -> tl(R1)]), R2. +-dialyzer({no_improper_lists, exsplus_next/1}). + %% Advance xorshift116+ state for one step and generate 58bit unsigned integer -spec exsplus_next(exsplus_state()) -> {uint58(), exsplus_state()}. exsplus_next([S1|S0]) -> diff --git a/lib/stdlib/src/random.erl b/lib/stdlib/src/random.erl index 8b67cde56c..8b639dd0a7 100644 --- a/lib/stdlib/src/random.erl +++ b/lib/stdlib/src/random.erl @@ -18,6 +18,7 @@ %% %CopyrightEnd% %% -module(random). +-deprecated(module). %% Reasonable random number generator. %% The method is attributed to B. A. Wichmann and I. D. Hill diff --git a/lib/stdlib/src/shell.erl b/lib/stdlib/src/shell.erl index ce1d9eb0ff..82a3a2be4f 100644 --- a/lib/stdlib/src/shell.erl +++ b/lib/stdlib/src/shell.erl @@ -917,9 +917,9 @@ expand_records(UsedRecords, E0) -> RecordDefs = [Def || {_Name,Def} <- UsedRecords], L = erl_anno:new(1), E = prep_rec(E0), - Forms = RecordDefs ++ [{function,L,foo,0,[{clause,L,[],[],[E]}]}], - [{function,L,foo,0,[{clause,L,[],[],[NE]}]}] = - erl_expand_records:module(Forms, [strict_record_tests]), + Forms0 = RecordDefs ++ [{function,L,foo,0,[{clause,L,[],[],[E]}]}], + Forms = erl_expand_records:module(Forms0, [strict_record_tests]), + {function,L,foo,0,[{clause,L,[],[],[NE]}]} = lists:last(Forms), prep_rec(NE). prep_rec({value,_CommandN,_V}=Value) -> @@ -1081,6 +1081,8 @@ record_fields([{record_field,_,{atom,_,Field}} | Fs]) -> [Field | record_fields(Fs)]; record_fields([{record_field,_,{atom,_,Field},_} | Fs]) -> [Field | record_fields(Fs)]; +record_fields([{typed_record_field,Field,_Type} | Fs]) -> + record_fields([Field | Fs]); record_fields([]) -> []. diff --git a/lib/stdlib/src/slave.erl b/lib/stdlib/src/slave.erl index 24fc8ce204..4e629a5e56 100644 --- a/lib/stdlib/src/slave.erl +++ b/lib/stdlib/src/slave.erl @@ -289,10 +289,7 @@ register_unique_name(Number) -> %% no need to use rsh. mk_cmd(Host, Name, Args, Waiter, Prog0) -> - Prog = case os:type() of - {ose,_} -> mk_ose_prog(Prog0); - _ -> quote_progname(Prog0) - end, + Prog = quote_progname(Prog0), BasicCmd = lists:concat([Prog, " -detached -noinput -master ", node(), " ", long_or_short(), Name, "@", Host, @@ -312,24 +309,6 @@ mk_cmd(Host, Name, Args, Waiter, Prog0) -> end end. -%% On OSE we have to pass the beam arguments directory to the slave -%% process. To find out what arguments that should be passed on we -%% make an assumption. All arguments after the last "--" should be -%% skipped. So given these arguments: -%% -Muycs256 -A 1 -- -root /mst/ -progname beam.debug.smp -- -home /mst/ -- -kernel inetrc '"/mst/inetrc.conf"' -- -name test@localhost -%% we send -%% -Muycs256 -A 1 -- -root /mst/ -progname beam.debug.smp -- -home /mst/ -- -kernel inetrc '"/mst/inetrc.conf"' -- -%% to the slave with whatever other args that are added in mk_cmd. -mk_ose_prog(Prog) -> - SkipTail = fun("--",[]) -> - ["--"]; - (_,[]) -> - []; - (Arg,Args) -> - [Arg," "|Args] - end, - [Prog,tl(lists:foldr(SkipTail,[],erlang:system_info(emu_args)))]. - %% This is an attempt to distinguish between spaces in the program %% path and spaces that separate arguments. The program is quoted to %% allow spaces in the path. diff --git a/lib/stdlib/src/stdlib.app.src b/lib/stdlib/src/stdlib.app.src index 7f9bbbf649..b8a7973cf2 100644 --- a/lib/stdlib/src/stdlib.app.src +++ b/lib/stdlib/src/stdlib.app.src @@ -105,7 +105,7 @@ dets]}, {applications, [kernel]}, {env, []}, - {runtime_dependencies, ["sasl-2.6","kernel-4.1","erts-7.0","crypto-3.3", + {runtime_dependencies, ["sasl-2.6","kernel-4.1","erts-7.3","crypto-3.3", "compiler-5.0"]} ]}. diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl index 92a0c29011..0400c845ab 100644 --- a/lib/stdlib/src/supervisor.erl +++ b/lib/stdlib/src/supervisor.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2015. 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. @@ -33,6 +33,9 @@ terminate/2, code_change/3]). -export([try_again_restart/2]). +%% For release_handler only +-export([get_callback_module/1]). + %%-------------------------------------------------------------------------- -export_type([sup_flags/0, child_spec/0, startchild_ret/0, strategy/0]). @@ -107,12 +110,15 @@ -define(SET, sets:set). -record(state, {name, - strategy :: strategy(), + strategy :: strategy() | 'undefined', children = [] :: [child_rec()], - dynamics :: ?DICT(pid(), list()) | ?SET(pid()), - intensity :: non_neg_integer(), - period :: pos_integer(), + dynamics :: {'dict', ?DICT(pid(), list())} + | {'set', ?SET(pid())} + | 'undefined', + intensity :: non_neg_integer() | 'undefined', + period :: pos_integer() | 'undefined', restarts = [], + dynamic_restarts = 0 :: non_neg_integer(), module, args}). -type state() :: #state{}. @@ -250,6 +256,17 @@ try_again_restart(Supervisor, Child) -> cast(Supervisor, Req) -> gen_server:cast(Supervisor, Req). +%%%----------------------------------------------------------------- +%%% Called by release_handler during upgrade +-spec get_callback_module(Pid) -> Module when + Pid :: pid(), + Module :: atom(). +get_callback_module(Pid) -> + {status, _Pid, {module, _Mod}, + [_PDict, _SysState, _Parent, _Dbg, Misc]} = sys:get_status(Pid), + [_Header, _Data, {data, [{"State", State}]}] = Misc, + State#state.module. + %%% --------------------------------------------------- %%% %%% Initialize the supervisor. @@ -504,39 +521,26 @@ handle_call(which_children, _From, State) -> handle_call(count_children, _From, #state{children = [#child{restart_type = temporary, child_type = CT}]} = State) when ?is_simple(State) -> - {Active, Count} = - ?SETS:fold(fun(Pid, {Alive, Tot}) -> - case is_pid(Pid) andalso is_process_alive(Pid) of - true ->{Alive+1, Tot +1}; - false -> - {Alive, Tot + 1} - end - end, {0, 0}, dynamics_db(temporary, State#state.dynamics)), + Sz = ?SETS:size(dynamics_db(temporary, State#state.dynamics)), Reply = case CT of - supervisor -> [{specs, 1}, {active, Active}, - {supervisors, Count}, {workers, 0}]; - worker -> [{specs, 1}, {active, Active}, - {supervisors, 0}, {workers, Count}] + supervisor -> [{specs, 1}, {active, Sz}, + {supervisors, Sz}, {workers, 0}]; + worker -> [{specs, 1}, {active, Sz}, + {supervisors, 0}, {workers, Sz}] end, {reply, Reply, State}; -handle_call(count_children, _From, #state{children = [#child{restart_type = RType, +handle_call(count_children, _From, #state{dynamic_restarts = Restarts, + children = [#child{restart_type = RType, child_type = CT}]} = State) when ?is_simple(State) -> - {Active, Count} = - ?DICTS:fold(fun(Pid, _Val, {Alive, Tot}) -> - case is_pid(Pid) andalso is_process_alive(Pid) of - true -> - {Alive+1, Tot +1}; - false -> - {Alive, Tot + 1} - end - end, {0, 0}, dynamics_db(RType, State#state.dynamics)), + Sz = ?DICTS:size(dynamics_db(RType, State#state.dynamics)), + Active = Sz - Restarts, Reply = case CT of supervisor -> [{specs, 1}, {active, Active}, - {supervisors, Count}, {workers, 0}]; + {supervisors, Sz}, {workers, 0}]; worker -> [{specs, 1}, {active, Active}, - {supervisors, 0}, {workers, Count}] + {supervisors, 0}, {workers, Sz}] end, {reply, Reply, State}; @@ -577,7 +581,7 @@ handle_cast({try_again_restart,Pid}, #state{children=[Child]}=State) when ?is_simple(State) -> RT = Child#child.restart_type, RPid = restarting(Pid), - case dynamic_child_args(RPid, dynamics_db(RT, State#state.dynamics)) of + case dynamic_child_args(RPid, RT, State#state.dynamics) of {ok, Args} -> {M, F, _} = Child#child.mfargs, NChild = Child#child{pid = RPid, mfargs = {M, F, Args}}, @@ -735,7 +739,7 @@ handle_start_child(Child, State) -> restart_child(Pid, Reason, #state{children = [Child]} = State) when ?is_simple(State) -> RestartType = Child#child.restart_type, - case dynamic_child_args(Pid, dynamics_db(RestartType, State#state.dynamics)) of + case dynamic_child_args(Pid, RestartType, State#state.dynamics) of {ok, Args} -> {M, F, _} = Child#child.mfargs, NChild = Child#child{pid = Pid, mfargs = {M, F, Args}}, @@ -806,20 +810,31 @@ restart(Child, State) -> {shutdown, remove_child(Child, NState)} end. -restart(simple_one_for_one, Child, State) -> +restart(simple_one_for_one, Child, State0) -> #child{pid = OldPid, mfargs = {M, F, A}} = Child, + State = case OldPid of + ?restarting(_) -> + NRes = State0#state.dynamic_restarts - 1, + State0#state{dynamic_restarts = NRes}; + _ -> + State0 + end, Dynamics = ?DICTS:erase(OldPid, dynamics_db(Child#child.restart_type, State#state.dynamics)), case do_start_child_i(M, F, A) of {ok, Pid} -> - NState = State#state{dynamics = ?DICTS:store(Pid, A, Dynamics)}, + DynamicsDb = {dict, ?DICTS:store(Pid, A, Dynamics)}, + NState = State#state{dynamics = DynamicsDb}, {ok, NState}; {ok, Pid, _Extra} -> - NState = State#state{dynamics = ?DICTS:store(Pid, A, Dynamics)}, + DynamicsDb = {dict, ?DICTS:store(Pid, A, Dynamics)}, + NState = State#state{dynamics = DynamicsDb}, {ok, NState}; {error, Error} -> - NState = State#state{dynamics = ?DICTS:store(restarting(OldPid), A, - Dynamics)}, + NRestarts = State#state.dynamic_restarts + 1, + DynamicsDb = {dict, ?DICTS:store(restarting(OldPid), A, Dynamics)}, + NState = State#state{dynamic_restarts = NRestarts, + dynamics = DynamicsDb}, report_error(start_error, Error, Child, State#state.name), {try_again, NState} end; @@ -1102,31 +1117,32 @@ save_child(Child, #state{children = Children} = State) -> State#state{children = [Child |Children]}. save_dynamic_child(temporary, Pid, _, #state{dynamics = Dynamics} = State) -> - State#state{dynamics = ?SETS:add_element(Pid, dynamics_db(temporary, Dynamics))}; + DynamicsDb = dynamics_db(temporary, Dynamics), + State#state{dynamics = {set, ?SETS:add_element(Pid, DynamicsDb)}}; save_dynamic_child(RestartType, Pid, Args, #state{dynamics = Dynamics} = State) -> - State#state{dynamics = ?DICTS:store(Pid, Args, dynamics_db(RestartType, Dynamics))}. + DynamicsDb = dynamics_db(RestartType, Dynamics), + State#state{dynamics = {dict, ?DICTS:store(Pid, Args, DynamicsDb)}}. dynamics_db(temporary, undefined) -> ?SETS:new(); dynamics_db(_, undefined) -> ?DICTS:new(); -dynamics_db(_,Dynamics) -> - Dynamics. - -dynamic_child_args(Pid, Dynamics) -> - case ?SETS:is_set(Dynamics) of - true -> - {ok, undefined}; - false -> - ?DICTS:find(Pid, Dynamics) - end. +dynamics_db(_, {_Tag, DynamicsDb}) -> + DynamicsDb. + +dynamic_child_args(_Pid, temporary, _DynamicsDb) -> + {ok, undefined}; +dynamic_child_args(Pid, _RT, {dict, DynamicsDb}) -> + ?DICTS:find(Pid, DynamicsDb); +dynamic_child_args(_Pid, _RT, undefined) -> + error. state_del_child(#child{pid = Pid, restart_type = temporary}, State) when ?is_simple(State) -> NDynamics = ?SETS:del_element(Pid, dynamics_db(temporary, State#state.dynamics)), - State#state{dynamics = NDynamics}; + State#state{dynamics = {set, NDynamics}}; state_del_child(#child{pid = Pid, restart_type = RType}, State) when ?is_simple(State) -> NDynamics = ?DICTS:erase(Pid, dynamics_db(RType, State#state.dynamics)), - State#state{dynamics = NDynamics}; + State#state{dynamics = {dict, NDynamics}}; state_del_child(Child, State) -> NChildren = del_child(Child#child.name, State#state.children), State#state{children = NChildren}. @@ -1160,19 +1176,19 @@ split_child(_, [], After) -> get_child(Name, State) -> get_child(Name, State, false). + get_child(Pid, State, AllowPid) when AllowPid, is_pid(Pid) -> get_dynamic_child(Pid, State); get_child(Name, State, _) -> lists:keysearch(Name, #child.name, State#state.children). get_dynamic_child(Pid, #state{children=[Child], dynamics=Dynamics}) -> - DynamicsDb = dynamics_db(Child#child.restart_type, Dynamics), - case is_dynamic_pid(Pid, DynamicsDb) of + case is_dynamic_pid(Pid, Dynamics) of true -> {value, Child#child{pid=Pid}}; false -> RPid = restarting(Pid), - case is_dynamic_pid(RPid, DynamicsDb) of + case is_dynamic_pid(RPid, Dynamics) of true -> {value, Child#child{pid=RPid}}; false -> @@ -1183,13 +1199,12 @@ get_dynamic_child(Pid, #state{children=[Child], dynamics=Dynamics}) -> end end. -is_dynamic_pid(Pid, Dynamics) -> - case ?SETS:is_set(Dynamics) of - true -> - ?SETS:is_element(Pid, Dynamics); - false -> - ?DICTS:is_key(Pid, Dynamics) - end. +is_dynamic_pid(Pid, {dict, Dynamics}) -> + ?DICTS:is_key(Pid, Dynamics); +is_dynamic_pid(Pid, {set, Dynamics}) -> + ?SETS:is_element(Pid, Dynamics); +is_dynamic_pid(_Pid, undefined) -> + false. replace_child(Child, State) -> Chs = do_replace_child(Child, State#state.children), diff --git a/lib/stdlib/src/unicode.erl b/lib/stdlib/src/unicode.erl index 3e8e6f5101..617da11ba8 100644 --- a/lib/stdlib/src/unicode.erl +++ b/lib/stdlib/src/unicode.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2013. All Rights Reserved. +%% Copyright Ericsson AB 2008-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. @@ -561,6 +561,8 @@ do_o_binary(F,L) -> erlang:iolist_to_binary(List) end. +-dialyzer({no_improper_lists, do_o_binary2/2}). + do_o_binary2(_F,[]) -> <<>>; do_o_binary2(F,[H|T]) -> diff --git a/lib/stdlib/src/zip.erl b/lib/stdlib/src/zip.erl index bec0bd3f6d..f8ba6f18e9 100644 --- a/lib/stdlib/src/zip.erl +++ b/lib/stdlib/src/zip.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2013. All Rights Reserved. +%% Copyright Ericsson AB 2006-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. @@ -1566,6 +1566,8 @@ append_bins([_|_]=List, B) -> append_bins([], B) -> B. +-dialyzer({no_improper_lists, pwrite_iolist/3}). + pwrite_iolist(B, Pos, Bin) -> {Left, Right} = split_binary(B, Pos), Sz = erlang:iolist_size(Bin), diff --git a/lib/stdlib/test/Makefile b/lib/stdlib/test/Makefile index e366c2b755..287f63b2be 100644 --- a/lib/stdlib/test/Makefile +++ b/lib/stdlib/test/Makefile @@ -107,8 +107,7 @@ RELSYSDIR = $(RELEASE_PATH)/stdlib_test # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include \ - -I$(ERL_TOP)/lib/kernel/include \ +ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/kernel/include \ -I$(ERL_TOP)/lib/stdlib/include EBIN = . diff --git a/lib/stdlib/test/array_SUITE.erl b/lib/stdlib/test/array_SUITE.erl index ab4ca91f76..6fec03a2f7 100644 --- a/lib/stdlib/test/array_SUITE.erl +++ b/lib/stdlib/test/array_SUITE.erl @@ -20,7 +20,7 @@ -module(array_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Default timetrap timeout (set in init_per_testcase). %% This should be set relatively high (10-15 times the expected diff --git a/lib/stdlib/test/base64_SUITE.erl b/lib/stdlib/test/base64_SUITE.erl index 75eebba6c6..f750145ef0 100644 --- a/lib/stdlib/test/base64_SUITE.erl +++ b/lib/stdlib/test/base64_SUITE.erl @@ -340,7 +340,7 @@ interleaved_ws_roundtrip_1([], Base64List, Bin, List) -> random_byte_list(0, Acc) -> Acc; random_byte_list(N, Acc) -> - random_byte_list(N-1, [random:uniform(255)|Acc]). + random_byte_list(N-1, [rand:uniform(255)|Acc]). make_big_binary(N) -> list_to_binary(mbb(N, [])). diff --git a/lib/stdlib/test/beam_lib_SUITE.erl b/lib/stdlib/test/beam_lib_SUITE.erl index c102f6e929..5de7b661e5 100644 --- a/lib/stdlib/test/beam_lib_SUITE.erl +++ b/lib/stdlib/test/beam_lib_SUITE.erl @@ -28,7 +28,7 @@ -define(t,test_server). -define(privdir, "beam_lib_SUITE_priv"). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(format(S, A), ok). -define(privdir, ?config(priv_dir, Conf)). -endif. diff --git a/lib/stdlib/test/binary_module_SUITE.erl b/lib/stdlib/test/binary_module_SUITE.erl index 70c946bdb9..8bb29b6a26 100644 --- a/lib/stdlib/test/binary_module_SUITE.erl +++ b/lib/stdlib/test/binary_module_SUITE.erl @@ -37,7 +37,7 @@ -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([init_per_testcase/2, end_per_testcase/2]). % Default timetrap timeout (set in init_per_testcase). % Some of these testcases are really heavy... @@ -536,6 +536,12 @@ do_interesting(Module) -> ?line [<<3>>,<<6>>] = Module:split(<<1,2,3,4,5,6,7,8>>, [<<1>>,<<2>>,<<4>>,<<5>>,<<7>>,<<8>>], [global,trim_all]), + [<<>>] = binary:split(<<>>, <<",">>, []), + [] = binary:split(<<>>, <<",">>, [trim]), + [] = binary:split(<<>>, <<",">>, [trim_all]), + [] = binary:split(<<>>, <<",">>, [global,trim]), + [] = binary:split(<<>>, <<",">>, [global,trim_all]), + ?line badarg = ?MASK_ERROR( Module:replace(<<1,2,3,4,5,6,7,8>>, [<<4,5>>,<<7>>,<<8>>],<<99>>, @@ -710,7 +716,7 @@ do_interesting(Module) -> encode_decode(doc) -> ["test binary:encode_unsigned/1,2 and binary:decode_unsigned/1,2"]; encode_decode(Config) when is_list(Config) -> - ?line random:seed({1271,769940,559934}), + rand:seed(exsplus, {1271,769940,559934}), ?line ok = encode_decode_loop({1,200},1000), % Need to be long enough % to create offheap binaries ok. @@ -817,7 +823,7 @@ copy(Config) when is_list(Config) -> ?line badarg = ?MASK_ERROR(binary:copy(<<1,2,3>>, 16#FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF)), ?line <<>> = binary:copy(<<>>,10000), - ?line random:seed({1271,769940,559934}), + rand:seed(exsplus, {1271,769940,559934}), ?line ok = random_copy(3000), ?line erts_debug:set_internal_state(available_internal_state,true), ?line io:format("oldlimit: ~p~n", @@ -855,7 +861,7 @@ random_copy(0) -> ok; random_copy(N) -> Str = random_string({0,N}), - Num = random:uniform(N div 10+1), + Num = rand:uniform(N div 10+1), A = ?MASK_ERROR(binary:copy(Str,Num)), B = ?MASK_ERROR(binref:copy(Str,Num)), C = ?MASK_ERROR(binary:copy(make_unaligned(Str),Num)), @@ -896,7 +902,7 @@ bin_to_list(Config) when is_list(Config) -> ?line [5] = lists:nthtail(byte_size(X)-1,LX), ?line [0,5] = lists:nthtail(byte_size(X)-2,LX), ?line [0,5] = lists:nthtail(byte_size(Y)-2,LY), - ?line random:seed({1271,769940,559934}), + rand:seed(exsplus, {1271,769940,559934}), ?line ok = random_bin_to_list(5000), ok. @@ -963,7 +969,7 @@ parts(Config) when is_list(Config) -> ?line badarg = ?MASK_ERROR(binary:part(Simple,{-1,0})), ?line badarg = ?MASK_ERROR(binary:part(Simple,{7,2})), ?line <<8>> = binary:part(Simple,{7,1}), - ?line random:seed({1271,769940,559934}), + rand:seed(exsplus, {1271,769940,559934}), ?line random_parts(5000), ok. @@ -987,15 +993,15 @@ random_parts(N) -> random_parts(0,_) -> []; random_parts(X,N) -> - Pos = random:uniform(N), - Len = random:uniform((Pos * 12) div 10), + Pos = rand:uniform(N), + Len = rand:uniform((Pos * 12) div 10), [{Pos,Len} | random_parts(X-1,N)]. random_ref_comp(doc) -> ["Test pseudorandomly generated cases against reference imlementation"]; random_ref_comp(Config) when is_list(Config) -> put(success_counter,0), - random:seed({1271,769940,559934}), + rand:seed(exsplus, {1271,769940,559934}), Nr = {1,40}, Hr = {30,1000}, I1 = 1500, @@ -1025,7 +1031,7 @@ random_ref_sr_comp(doc) -> ["Test pseudorandomly generated cases against reference imlementation of split and replace"]; random_ref_sr_comp(Config) when is_list(Config) -> put(success_counter,0), - random:seed({1271,769940,559934}), + rand:seed(exsplus, {1271,769940,559934}), Nr = {1,40}, Hr = {30,1000}, I1 = 1500, @@ -1043,7 +1049,7 @@ random_ref_fla_comp(doc) -> ["Test pseudorandomly generated cases against reference imlementation of split and replace"]; random_ref_fla_comp(Config) when is_list(Config) -> ?line put(success_counter,0), - ?line random:seed({1271,769940,559934}), + rand:seed(exsplus, {1271,769940,559934}), ?line do_random_first_comp(5000,{1,1000}), ?line do_random_last_comp(5000,{1,1000}), ?line do_random_at_comp(5000,{1,1000}), @@ -1377,24 +1383,24 @@ one_random(N) -> random_number({Min,Max}) -> % Min and Max are *length* of number in % decimal positions - X = random:uniform(Max - Min + 1) + Min - 1, - list_to_integer([one_random_number(random:uniform(10)) || _ <- lists:seq(1,X)]). + X = rand:uniform(Max - Min + 1) + Min - 1, + list_to_integer([one_random_number(rand:uniform(10)) || _ <- lists:seq(1,X)]). random_length({Min,Max}) -> - random:uniform(Max - Min + 1) + Min - 1. + rand:uniform(Max - Min + 1) + Min - 1. random_string({Min,Max}) -> - X = random:uniform(Max - Min + 1) + Min - 1, - list_to_binary([one_random(random:uniform(68)) || _ <- lists:seq(1,X)]). + X = rand:uniform(Max - Min + 1) + Min - 1, + list_to_binary([one_random(rand:uniform(68)) || _ <- lists:seq(1,X)]). random_substring({Min,Max},Hay) -> - X = random:uniform(Max - Min + 1) + Min - 1, + X = rand:uniform(Max - Min + 1) + Min - 1, Y = byte_size(Hay), Z = if X > Y -> Y; true -> X end, PMax = Y - Z, - Pos = random:uniform(PMax + 1) - 1, + Pos = rand:uniform(PMax + 1) - 1, <<_:Pos/binary,Res:Z/binary,_/binary>> = Hay, Res. diff --git a/lib/stdlib/test/c_SUITE.erl b/lib/stdlib/test/c_SUITE.erl index f3a713abfd..47dd95f86b 100644 --- a/lib/stdlib/test/c_SUITE.erl +++ b/lib/stdlib/test/c_SUITE.erl @@ -23,7 +23,7 @@ -export([c_1/1, c_2/1, c_3/1, c_4/1, nc_1/1, nc_2/1, nc_3/1, nc_4/1, ls/1, memory/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -import(c, [c/2, nc/2]). diff --git a/lib/stdlib/test/calendar_SUITE.erl b/lib/stdlib/test/calendar_SUITE.erl index 498b1f459c..bddc3a4821 100644 --- a/lib/stdlib/test/calendar_SUITE.erl +++ b/lib/stdlib/test/calendar_SUITE.erl @@ -19,7 +19,7 @@ %% -module(calendar_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, diff --git a/lib/stdlib/test/dets_SUITE.erl b/lib/stdlib/test/dets_SUITE.erl index 7f5e06524a..ee3a812e24 100644 --- a/lib/stdlib/test/dets_SUITE.erl +++ b/lib/stdlib/test/dets_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. 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. @@ -28,7 +28,7 @@ -define(privdir(_), "./dets_SUITE_priv"). -define(datadir(_), "./dets_SUITE_data"). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(format(S, A), ok). -define(privdir(Conf), ?config(priv_dir, Conf)). -define(datadir(Conf), ?config(data_dir, Conf)). @@ -53,7 +53,8 @@ simultaneous_open/1, insert_new/1, repair_continuation/1, otp_5487/1, otp_6206/1, otp_6359/1, otp_4738/1, otp_7146/1, otp_8070/1, otp_8856/1, otp_8898/1, otp_8899/1, otp_8903/1, - otp_8923/1, otp_9282/1, otp_11245/1, otp_11709/1]). + otp_8923/1, otp_9282/1, otp_11245/1, otp_11709/1, otp_13229/1, + otp_13260/1]). -export([dets_dirty_loop/0]). @@ -110,7 +111,8 @@ all() -> many_clients, otp_4906, otp_5402, simultaneous_open, insert_new, repair_continuation, otp_5487, otp_6206, otp_6359, otp_4738, otp_7146, otp_8070, otp_8856, otp_8898, - otp_8899, otp_8903, otp_8923, otp_9282, otp_11245, otp_11709 + otp_8899, otp_8903, otp_8923, otp_9282, otp_11245, otp_11709, + otp_13229, otp_13260 ]. groups() -> @@ -1876,9 +1878,33 @@ fixtable(Config, Version) when is_list(Config) -> {ok, _} = dets:open_file(T, [{type, duplicate_bag} | Args]), %% In a fixed table, delete and re-insert an object. ok = dets:insert(T, {1, a, b}), + SysBefore = erlang:timestamp(), + MonBefore = erlang:monotonic_time(), dets:safe_fixtable(T, true), + MonAfter = erlang:monotonic_time(), + SysAfter = erlang:timestamp(), + Self = self(), + {FixMonTime,[{Self,1}]} = dets:info(T,safe_fixed_monotonic_time), + {FixSysTime,[{Self,1}]} = dets:info(T,safe_fixed), + true = is_integer(FixMonTime), + true = MonBefore =< FixMonTime, + true = FixMonTime =< MonAfter, + {FstMs,FstS,FstUs} = FixSysTime, + true = is_integer(FstMs), + true = is_integer(FstS), + true = is_integer(FstUs), + case erlang:system_info(time_warp_mode) of + no_time_warp -> + true = timer:now_diff(FixSysTime, SysBefore) >= 0, + true = timer:now_diff(SysAfter, FixSysTime) >= 0; + _ -> + %% ets:info(Tab,safe_fixed) not timewarp safe... + ignore + end, ok = dets:match_delete(T, {1, a, b}), ok = dets:insert(T, {1, a, b}), + {FixMonTime,[{Self,1}]} = dets:info(T,safe_fixed_monotonic_time), + {FixSysTime,[{Self,1}]} = dets:info(T,safe_fixed), dets:safe_fixtable(T, false), 1 = length(dets:match_object(T, '_')), @@ -3988,6 +4014,66 @@ otp_11709(Config) when is_list(Config) -> _ = file:delete(File), ok. +otp_13229(doc) -> + ["OTP-13229. open_file() exits with badarg when given binary file name."]; +otp_13229(_Config) -> + F = <<"binfile.tab">>, + try dets:open_file(name, [{file, F}]) of + R -> + exit({open_succeeded, R}) + catch + error:badarg -> + ok + end. + +otp_13260(doc) -> + ["OTP-13260. Race when opening a table."]; +otp_13260(Config) -> + [ok] = lists:usort([otp_13260_1(Config) || _ <- lists:seq(1, 3)]), + ok. + +otp_13260_1(Config) -> + Tab = otp_13260, + File = filename(Tab, Config), + N = 20, + P = self(), + Pids = [spawn_link(fun() -> counter(P, Tab, File) end) || + _ <- lists:seq(1, N)], + Rs = rec(Pids), + true = lists:all(fun(R) -> is_integer(R) end, Rs), + wait_for_close(Tab). + +rec([]) -> + []; +rec([Pid | Pids]) -> + receive {Pid, R} -> + [R | rec(Pids)] + end. + +%% One may have to run the test several times to trigger the bug. +counter(P, Tab, File) -> + Key = key, + N = case catch dets:update_counter(Tab, Key, 1) of + {'EXIT', _} -> + {ok, Tab} = dets:open_file(Tab, [{file, File}]), + ok = dets:insert(Tab, {Key, 1}), + dets:update_counter(Tab, Key, 1); + N1 when is_integer(N1) -> + N1; + DetsBug -> + DetsBug + end, + P ! {self(), N}. + +wait_for_close(Tab) -> + case dets:info(Tab, owner) of + undefined -> + ok; + _ -> + timer:sleep(100), + wait_for_close(Tab) + end. + %% %% Parts common to several test cases %% diff --git a/lib/stdlib/test/dict_SUITE.erl b/lib/stdlib/test/dict_SUITE.erl index 648154ebbe..92d31bb748 100644 --- a/lib/stdlib/test/dict_SUITE.erl +++ b/lib/stdlib/test/dict_SUITE.erl @@ -28,7 +28,7 @@ init_per_testcase/2,end_per_testcase/2, create/1,store/1,iterate/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -import(lists, [foldl/3]). @@ -108,7 +108,7 @@ iterate_1(M) -> M(empty, []). iterate_2(M) -> - random:seed(1, 2, 42), + rand:seed(exsplus, {1,2,42}), iter_tree(M, 1000). iter_tree(_M, 0) -> @@ -117,7 +117,7 @@ iter_tree(M, N) -> L = [{I, I} || I <- lists:seq(1, N)], T = M(from_list, L), L = lists:reverse(iterate_tree(M, T)), - R = random:uniform(N), + R = rand:uniform(N), KV = lists:reverse(iterate_tree_from(M, R, T)), KV = [P || P={K,_} <- L, K >= R], iter_tree(M, N-1). @@ -156,7 +156,7 @@ test_all(Tester) -> spawn_tester(M, Tester) -> Parent = self(), spawn_link(fun() -> - random:seed(1, 2, 42), + rand:seed(exsplus, {1,2,42}), S = Tester(M), Res = {M(size, S),lists:sort(M(to_list, S))}, Parent ! {result,self(),Res} @@ -194,12 +194,12 @@ rnd_list_1(0, Acc) -> Acc; rnd_list_1(N, Acc) -> Key = atomic_rnd_term(), - Value = random:uniform(100), + Value = rand:uniform(100), rnd_list_1(N-1, [{Key,Value}|Acc]). atomic_rnd_term() -> - case random:uniform(3) of - 1 -> list_to_atom(integer_to_list($\s+random:uniform(94))++"rnd"); - 2 -> random:uniform(); - 3 -> random:uniform(50)-37 + case rand:uniform(3) of + 1 -> list_to_atom(integer_to_list($\s+rand:uniform(94))++"rnd"); + 2 -> rand:uniform(); + 3 -> rand:uniform(50)-37 end. diff --git a/lib/stdlib/test/digraph_SUITE.erl b/lib/stdlib/test/digraph_SUITE.erl index 9e007fe17d..97561196d8 100644 --- a/lib/stdlib/test/digraph_SUITE.erl +++ b/lib/stdlib/test/digraph_SUITE.erl @@ -24,7 +24,7 @@ -ifdef(STANDALONE). -define(line, put(line, ?LINE), ). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -endif. -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/lib/stdlib/test/digraph_utils_SUITE.erl b/lib/stdlib/test/digraph_utils_SUITE.erl index 747ccf322c..e155857bd4 100644 --- a/lib/stdlib/test/digraph_utils_SUITE.erl +++ b/lib/stdlib/test/digraph_utils_SUITE.erl @@ -23,7 +23,7 @@ -ifdef(debug). -define(line, put(line, ?LINE), ). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -endif. -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/lib/stdlib/test/edlin_expand_SUITE.erl b/lib/stdlib/test/edlin_expand_SUITE.erl index 6fdc4c35df..b0a07a95a3 100644 --- a/lib/stdlib/test/edlin_expand_SUITE.erl +++ b/lib/stdlib/test/edlin_expand_SUITE.erl @@ -25,7 +25,7 @@ -export([init_per_testcase/2, end_per_testcase/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Default timetrap timeout (set in init_per_testcase). -define(default_timeout, ?t:minutes(1)). diff --git a/lib/stdlib/test/epp_SUITE.erl b/lib/stdlib/test/epp_SUITE.erl index 4e5df661b3..0c00e104b7 100644 --- a/lib/stdlib/test/epp_SUITE.erl +++ b/lib/stdlib/test/epp_SUITE.erl @@ -25,9 +25,9 @@ upcase_mac_1/1, upcase_mac_2/1, variable_1/1, otp_4870/1, otp_4871/1, otp_5362/1, pmod/1, not_circular/1, skip_header/1, otp_6277/1, otp_7702/1, - otp_8130/1, overload_mac/1, otp_8388/1, otp_8470/1, otp_8503/1, + otp_8130/1, overload_mac/1, otp_8388/1, otp_8470/1, otp_8562/1, otp_8665/1, otp_8911/1, otp_10302/1, otp_10820/1, - otp_11728/1, encoding/1]). + otp_11728/1, encoding/1, extends/1, function_macro/1]). -export([epp_parse_erl_form/2]). @@ -47,7 +47,7 @@ config(priv_dir, _) -> config(data_dir, _) -> filename:absname("./epp_SUITE_data"). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([init_per_testcase/2, end_per_testcase/2]). % Default timetrap timeout (set in init_per_testcase). @@ -68,9 +68,9 @@ all() -> [rec_1, {group, upcase_mac}, include_local, predef_mac, {group, variable}, otp_4870, otp_4871, otp_5362, pmod, not_circular, skip_header, otp_6277, otp_7702, otp_8130, - overload_mac, otp_8388, otp_8470, otp_8503, otp_8562, + overload_mac, otp_8388, otp_8470, otp_8562, otp_8665, otp_8911, otp_10302, otp_10820, otp_11728, - encoding]. + encoding, extends, function_macro]. groups() -> [{upcase_mac, [], [upcase_mac_1, upcase_mac_2]}, @@ -621,6 +621,10 @@ otp_8130(Config) when is_list(Config) -> " 2 end,\n" " 7),\n" " {2,7} =\n" + " ?M1(begin 1 = fun _Name () -> 1 end(),\n" + " 2 end,\n" + " 7),\n" + " {2,7} =\n" " ?M1(begin 1 = fun t0/0(),\n" " 2 end,\n" " 7),\n" @@ -645,6 +649,9 @@ otp_8130(Config) when is_list(Config) -> " ?M1(begin yes = try 1 of 1 -> yes after foo end,\n" " 2 end,\n" " 7),\n" + " {[42],7} =\n" + " ?M1([42],\n" + " 7),\n" "ok.\n">>, ok}, @@ -728,11 +735,16 @@ otp_8130(Config) when is_list(Config) -> {errors,[{{2,2},epp,{include,lib,"$apa/foo.hrl"}}],[]}}, - {otp_8130_c9, + {otp_8130_c9a, <<"-define(S, ?S).\n" "t() -> ?S.\n">>, {errors,[{{2,9},epp,{circular,'S', none}}],[]}}, + {otp_8130_c9b, + <<"-define(S(), ?S()).\n" + "t() -> ?S().\n">>, + {errors,[{{2,9},epp,{circular,'S', 0}}],[]}}, + {otp_8130_c10, <<"\n-file.">>, {errors,[{{2,2},epp,{bad,file}}],[]}}, @@ -799,6 +811,10 @@ otp_8130(Config) when is_list(Config) -> <<"\n-include(\"no such file.erl\").\n">>, {errors,[{{2,2},epp,{include,file,"no such file.erl"}}],[]}}, + {otp_8130_c25, + <<"\n-define(A.\n">>, + {errors,[{{2,2},epp,{bad,define}}],[]}}, + {otp_8130_7, <<"-record(b, {b}).\n" "-define(A, {{a,#b.b.\n" @@ -826,14 +842,15 @@ otp_8130(Config) when is_list(Config) -> "-define(a, 3.14).\n" "t() -> ?a.\n"), ?line {ok,Epp} = epp:open(File, []), - ?line ['BASE_MODULE','BASE_MODULE_STRING','BEAM','FILE','LINE', - 'MACHINE','MODULE','MODULE_STRING'] = macs(Epp), + PreDefMacs = macs(Epp), + ['BASE_MODULE','BASE_MODULE_STRING','BEAM','FILE', + 'FUNCTION_ARITY','FUNCTION_NAME', + 'LINE','MACHINE','MODULE','MODULE_STRING'] = PreDefMacs, ?line {ok,[{'-',_},{atom,_,file}|_]} = epp:scan_erl_form(Epp), ?line {ok,[{'-',_},{atom,_,module}|_]} = epp:scan_erl_form(Epp), ?line {ok,[{atom,_,t}|_]} = epp:scan_erl_form(Epp), ?line {eof,_} = epp:scan_erl_form(Epp), - ?line ['BASE_MODULE','BASE_MODULE_STRING','BEAM','FILE','LINE', - 'MACHINE','MODULE','MODULE_STRING',a] = macs(Epp), + [a] = macs(Epp) -- PreDefMacs, ?line epp:close(Epp), %% escript @@ -1214,23 +1231,8 @@ otp_8470(Config) when is_list(Config) -> ?line receive _ -> fail() after 0 -> ok end, ok. -otp_8503(doc) -> - ["OTP-8503. Record with no fields is considered typed."]; -otp_8503(suite) -> - []; -otp_8503(Config) when is_list(Config) -> - Dir = ?config(priv_dir, Config), - C = <<"-record(r, {}).">>, - ?line File = filename:join(Dir, "otp_8503.erl"), - ?line ok = file:write_file(File, C), - ?line {ok, List} = epp:parse_file(File, [], []), - ?line [_] = [F || {attribute,_,type,{{record,r},[],[]}}=F <- List], - file:delete(File), - ?line receive _ -> fail() after 0 -> ok end, - ok. - otp_8562(doc) -> - ["OTP-8503. Record with no fields is considered typed."]; + ["OTP-8562. Record with no fields is considered typed."]; otp_8562(suite) -> []; otp_8562(Config) when is_list(Config) -> @@ -1476,6 +1478,102 @@ encoding(Config) when is_list(Config) -> epp_parse_file(ErlFile, [{default_encoding,utf8},extra]), ok. +extends(Config) -> + Cs = [{extends_c1, + <<"-extends(some.other.module).\n">>, + {errors,[{1,erl_parse,["syntax error before: ","'.'"]}],[]}}], + [] = compile(Config, Cs), + + Ts = [{extends_1, + <<"-extends(some_other_module).\n" + "t() -> {?BASE_MODULE,?BASE_MODULE_STRING}.\n">>, + {some_other_module,"some_other_module"}}], + + [] = run(Config, Ts), + ok. + +function_macro(Config) -> + Cs = [{f_c1, + <<"-define(FUNCTION_NAME, a).\n" + "-define(FUNCTION_ARITY, a).\n" + "-define(FS,\n" + " atom_to_list(?FUNCTION_NAME) ++ \"/\" ++\n" + " integer_to_list(?FUNCTION_ARITY)).\n" + "-attr({f,?FUNCTION_NAME}).\n" + "-attr2(?FS).\n" + "-file(?FUNCTION_ARITY, 1).\n" + "f1() ?FUNCTION_NAME/?FUNCTION_ARITY.\n" + "f2(?FUNCTION_NAME.\n">>, + {errors,[{1,epp,{redefine_predef,'FUNCTION_NAME'}}, + {2,epp,{redefine_predef,'FUNCTION_ARITY'}}, + {6,epp,{illegal_function,'FUNCTION_NAME'}}, + {7,epp,{illegal_function,'FUNCTION_NAME'}}, + {8,epp,{illegal_function,'FUNCTION_ARITY'}}, + {9,erl_parse,["syntax error before: ","f1"]}, + {10,erl_parse,["syntax error before: ","'.'"]}], + []}}, + + {f_c2, + <<"a({a) -> ?FUNCTION_NAME.\n" + "b(}{) -> ?FUNCTION_ARITY.\n" + "c(?FUNCTION_NAME, ?not_defined) -> ok.\n">>, + {errors,[{1,erl_parse,["syntax error before: ","')'"]}, + {2,erl_parse,["syntax error before: ","'}'"]}, + {3,epp,{undefined,not_defined,none}}], + []}}, + + {f_c3, + <<"?FUNCTION_NAME() -> ok.\n" + "?FUNCTION_ARITY() -> ok.\n">>, + {errors,[{1,epp,{illegal_function_usage,'FUNCTION_NAME'}}, + {2,epp,{illegal_function_usage,'FUNCTION_ARITY'}}], + []}} + ], + + [] = compile(Config, Cs), + + Ts = [{f_1, + <<"t() -> {a,0} = a(), {b,1} = b(1), {c,2} = c(1, 2),\n" + " {d,1} = d({d,1}), {foo,1} = foo(foo), ok.\n" + "a() -> {?FUNCTION_NAME,?FUNCTION_ARITY}.\n" + "b(_) -> {?FUNCTION_NAME,?FUNCTION_ARITY}.\n" + "c(_, (_)) -> {?FUNCTION_NAME,?FUNCTION_ARITY}.\n" + "d({?FUNCTION_NAME,?FUNCTION_ARITY}=F) -> F.\n" + "-define(FOO, foo).\n" + "?FOO(?FOO) -> {?FUNCTION_NAME,?FUNCTION_ARITY}.\n">>, + ok}, + + {f_2, + <<"t() ->\n" + " A = {a,[<<0:24>>,#{a=>1,b=>2}]},\n" + " 1 = a(A),\n" + " ok.\n" + "a({a,[<<_,_,_>>,#{a:=1,b:=2}]}) -> ?FUNCTION_ARITY.\n">>, + ok}, + + {f_3, + <<"-define(FS,\n" + " atom_to_list(?FUNCTION_NAME) ++ \"/\" ++\n" + " integer_to_list(?FUNCTION_ARITY)).\n" + "t() ->\n" + " {t,0} = {?FUNCTION_NAME,?FUNCTION_ARITY},\n" + " \"t/0\" = ?FS,\n" + " ok.\n">>, + ok}, + + {f_4, + <<"-define(__, _, _).\n" + "-define(FF, ?FUNCTION_NAME, ?FUNCTION_ARITY).\n" + "a(?__) -> 2 = ?FUNCTION_ARITY.\n" + "b(?FUNCTION_ARITY, ?__) -> ok.\n" + "c(?FF) -> ok.\n" + "t() -> a(1, 2), b(3, 1, 2), c(c, 2), ok.\n">>, + ok} + ], + [] = run(Config, Ts), + + ok. + check(Config, Tests) -> eval_tests(Config, fun check_test/2, Tests). @@ -1504,15 +1602,17 @@ eval_tests(Config, Fun, Tests) -> check_test(Config, Test) -> Filename = "epp_test.erl", - ?line PrivDir = ?config(priv_dir, Config), - ?line File = filename:join(PrivDir, Filename), - ?line ok = file:write_file(File, Test), - ?line case epp:parse_file(File, [PrivDir], []) of - {ok,Forms} -> - [E || E={error,_} <- Forms]; - {error,Error} -> - Error - end. + PrivDir = ?config(priv_dir, Config), + File = filename:join(PrivDir, Filename), + ok = file:write_file(File, Test), + case epp:parse_file(File, [PrivDir], []) of + {ok,Forms} -> + Errors = [E || E={error,_} <- Forms], + call_format_error([E || {error,E} <- Errors]), + Errors; + {error,Error} -> + Error + end. compile_test(Config, Test0) -> Test = [<<"-module(epp_test). -compile(export_all). ">>, Test0], @@ -1528,8 +1628,11 @@ compile_test(Config, Test0) -> warnings(File, Ws) -> case lists:append([W || {F, W} <- Ws, F =:= File]) of - [] -> []; - L -> {warnings, L} + [] -> + []; + L -> + call_format_error(L), + {warnings, L} end. compile_file(File, Opts) -> @@ -1540,12 +1643,20 @@ compile_file(File, Opts) -> end. errs([{File,Es}|L], File) -> + call_format_error(Es), Es ++ errs(L, File); errs([_|L], File) -> errs(L, File); errs([], _File) -> []. +%% Smoke test and coverage of format_error/1. +call_format_error([{_,M,E}|T]) -> + _ = M:format_error(E), + call_format_error(T); +call_format_error([]) -> + ok. + epp_parse_file(File, Opts) -> case epp:parse_file(File, Opts) of {ok, Forms} -> diff --git a/lib/stdlib/test/erl_anno_SUITE.erl b/lib/stdlib/test/erl_anno_SUITE.erl index 66b02151a0..79b27c6217 100644 --- a/lib/stdlib/test/erl_anno_SUITE.erl +++ b/lib/stdlib/test/erl_anno_SUITE.erl @@ -22,10 +22,10 @@ %-define(debug, true). -ifdef(debug). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(format(S, A), io:format(S, A)). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(format(S, A), ok). -endif. @@ -34,7 +34,7 @@ init_per_testcase/2, end_per_testcase/2]). -export([new/1, is_anno/1, generated/1, end_location/1, file/1, - line/1, location/1, record/1, text/1, bad/1, neg_line/1]). + line/1, location/1, record/1, text/1, bad/1]). -export([parse_abstract/1, mapfold_anno/1]). @@ -43,7 +43,7 @@ all() -> groups() -> [{anno, [], [new, is_anno, generated, end_location, file, - line, location, record, text, bad, neg_line]}, + line, location, record, text, bad]}, {parse, [], [parse_abstract, mapfold_anno]}]. suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -229,74 +229,6 @@ bad(_Config) -> (catch erl_anno:record(bad)), % 1st arg not opaque ok. -neg_line(doc) -> - ["Test negative line numbers (OTP 18)"]; -neg_line(_Config) -> - neg_line1(false), - neg_line1(true), - ok. - -neg_line1(TextToo) -> - Minus8_0 = erl_anno:new(-8), - Plus8_0 = erl_anno:new(8), - Minus8C_0 = erl_anno:new({-8, 17}), - Plus8C_0 = erl_anno:new({8, 17}), - - [Minus8, Plus8, Minus8C, Plus8C] = - [case TextToo of - true -> - erl_anno:set_text("foo", A); - false -> - A - end || A <- [Minus8_0, Plus8_0, Minus8C_0, Plus8C_0]], - - tst(-3, erl_anno:set_location(3, Minus8)), - tst(-3, erl_anno:set_location(-3, Plus8)), - tst(-3, erl_anno:set_location(-3, Minus8)), - tst({-3,9}, erl_anno:set_location({3, 9}, Minus8)), - tst({-3,9}, erl_anno:set_location({-3, 9}, Plus8)), - tst({-3,9}, erl_anno:set_location({-3, 9}, Minus8)), - tst(-3, erl_anno:set_location(3, Minus8C)), - tst(-3, erl_anno:set_location(-3, Plus8C)), - tst(-3, erl_anno:set_location(-3, Minus8C)), - tst({-3,9}, erl_anno:set_location({3, 9}, Minus8C)), - tst({-3,9}, erl_anno:set_location({-3, 9}, Plus8C)), - tst({-3,9}, erl_anno:set_location({-3, 9}, Minus8C)), - - tst(-8, erl_anno:set_generated(true, Plus8)), - tst(-8, erl_anno:set_generated(true, Minus8)), - tst({-8,17}, erl_anno:set_generated(true, Plus8C)), - tst({-8,17}, erl_anno:set_generated(true, Minus8C)), - tst(8, erl_anno:set_generated(false, Plus8)), - tst(8, erl_anno:set_generated(false, Minus8)), - tst({8,17}, erl_anno:set_generated(false, Plus8C)), - tst({8,17}, erl_anno:set_generated(false, Minus8C)), - - tst(-3, erl_anno:set_line(3, Minus8)), - tst(-3, erl_anno:set_line(-3, Plus8)), - tst(-3, erl_anno:set_line(-3, Minus8)), - tst({-3,17}, erl_anno:set_line(3, Minus8C)), - tst({-3,17}, erl_anno:set_line(-3, Plus8C)), - tst({-3,17}, erl_anno:set_line(-3, Minus8C)), - ok. - -tst(Term, Anno) -> - ?format("Term: ~p\n", [Term]), - ?format("Anno: ~p\n", [Anno]), - case anno_to_term(Anno) of - Term -> - ok; - Else -> - case lists:keyfind(location, 1, Else) of - {location, Term} -> - ok; - _Else2 -> - ?format("Else2 ~p\n", [_Else2]), - io:format("expected ~p\n got ~p\n", [Term, Else]), - exit({Term, Else}) - end - end. - parse_abstract(doc) -> ["Test erl_parse:new_anno/1, erl_parse:anno_to_term/1" ", and erl_parse:anno_from_term/1"]; diff --git a/lib/stdlib/test/erl_eval_SUITE.erl b/lib/stdlib/test/erl_eval_SUITE.erl index b9c4ad0a46..1874ee1a1d 100644 --- a/lib/stdlib/test/erl_eval_SUITE.erl +++ b/lib/stdlib/test/erl_eval_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2013. All Rights Reserved. +%% 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. @@ -39,6 +39,7 @@ otp_7550/1, otp_8133/1, otp_10622/1, + otp_13228/1, funs/1, try_catch/1, eval_expr_5/1, @@ -63,7 +64,7 @@ config(priv_dir,_) -> ".". -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([init_per_testcase/2, end_per_testcase/2]). % Default timetrap timeout (set in init_per_testcase). -define(default_timeout, ?t:minutes(1)). @@ -83,7 +84,8 @@ all() -> pattern_expr, match_bin, guard_3, guard_4, guard_5, lc, simple_cases, unary_plus, apply_atom, otp_5269, otp_6539, otp_6543, otp_6787, otp_6977, otp_7550, - otp_8133, otp_10622, funs, try_catch, eval_expr_5, zero_width, + otp_8133, otp_10622, otp_13228, + funs, try_catch, eval_expr_5, zero_width, eep37, eep43]. groups() -> @@ -1042,6 +1044,13 @@ otp_10622(Config) when is_list(Config) -> ok. +otp_13228(doc) -> + ["OTP-13228. ERL-32: non-local function handler bug."]; +otp_13228(_Config) -> + LFH = {value, fun(foo, [io_fwrite]) -> worked end}, + EFH = {value, fun({io, fwrite}, [atom]) -> io_fwrite end}, + {value, worked, []} = parse_and_run("foo(io:fwrite(atom)).", LFH, EFH). + funs(doc) -> ["Simple cases, just to cover some code."]; funs(suite) -> @@ -1483,6 +1492,16 @@ eep43(Config) when is_list(Config) -> " #{ K1 := 1, K2 := 2, K3 := 3, {2,2} := 4} = Map " "end.", #{ 1 => 1, <<42:301>> => 2, {3,<<42:301>>} => 3, {2,2} => 4}), + check(fun () -> + X = key, + (fun(#{X := value}) -> true end)(#{X => value}) + end, + "begin " + " X = key, " + " (fun(#{X := value}) -> true end)(#{X => value}) " + "end.", + true), + error_check("[camembert]#{}.", {badmap,[camembert]}), error_check("[camembert]#{nonexisting:=v}.", {badmap,[camembert]}), error_check("#{} = 1.", {badmatch,1}), diff --git a/lib/stdlib/test/erl_expand_records_SUITE.erl b/lib/stdlib/test/erl_expand_records_SUITE.erl index 8cec445cb4..2cc4757c04 100644 --- a/lib/stdlib/test/erl_expand_records_SUITE.erl +++ b/lib/stdlib/test/erl_expand_records_SUITE.erl @@ -28,7 +28,7 @@ -define(privdir, "erl_expand_records_SUITE_priv"). -define(t, test_server). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(privdir, ?config(priv_dir, Config)). -endif. diff --git a/lib/stdlib/test/erl_internal_SUITE.erl b/lib/stdlib/test/erl_internal_SUITE.erl index 0d2f535040..ad0b37aae3 100644 --- a/lib/stdlib/test/erl_internal_SUITE.erl +++ b/lib/stdlib/test/erl_internal_SUITE.erl @@ -26,7 +26,7 @@ -export([init_per_testcase/2, end_per_testcase/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index 5347ccaf1f..d946469625 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2015. 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. @@ -28,7 +28,7 @@ -define(privdir, "erl_lint_SUITE_priv"). -define(t, test_server). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(datadir, ?config(data_dir, Conf)). -define(privdir, ?config(priv_dir, Conf)). -endif. @@ -65,7 +65,8 @@ too_many_arguments/1, basic_errors/1,bin_syntax_errors/1, predef/1, - maps/1,maps_type/1,otp_11851/1,otp_12195/1 + maps/1,maps_type/1,otp_11851/1,otp_11879/1,otp_13230/1, + record_errors/1 ]). % Default timetrap timeout (set in init_per_testcase). @@ -94,7 +95,8 @@ all() -> bif_clash, behaviour_basic, behaviour_multiple, otp_11861, otp_7550, otp_8051, format_warn, {group, on_load}, too_many_arguments, basic_errors, bin_syntax_errors, predef, - maps, maps_type, otp_11851, otp_12195]. + maps, maps_type, otp_11851, otp_11879, otp_13230, + record_errors]. groups() -> [{unused_vars_warn, [], @@ -1296,12 +1298,16 @@ unsized_binary_in_bin_gen_pattern(Config) when is_list(Config) -> Ts = [{unsized_binary_in_bin_gen_pattern, <<"t({bc,binary,Bin}) -> << <<X,Tail/binary>> || <<X,Tail/binary>> <= Bin >>; + t({bc,bytes,Bin}) -> + << <<X,Tail/binary>> || <<X,Tail/bytes>> <= Bin >>; t({bc,bits,Bin}) -> << <<X,Tail/bits>> || <<X,Tail/bits>> <= Bin >>; t({bc,bitstring,Bin}) -> << <<X,Tail/bits>> || <<X,Tail/bitstring>> <= Bin >>; t({lc,binary,Bin}) -> [ {X,Tail} || <<X,Tail/binary>> <= Bin ]; + t({lc,bytes,Bin}) -> + [ {X,Tail} || <<X,Tail/bytes>> <= Bin ]; t({lc,bits,Bin}) -> [ {X,Tail} || <<X,Tail/bits>> <= Bin ]; t({lc,bitstring,Bin}) -> @@ -1313,7 +1319,9 @@ unsized_binary_in_bin_gen_pattern(Config) when is_list(Config) -> {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}], + {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}], []}}], [] = run(Config, Ts), ok. @@ -2599,6 +2607,23 @@ otp_5878(Config) when is_list(Config) -> ">>, ?line [] = run_test2(Config, UsedByType, [warn_unused_record]), + %% Abstract code generated by OTP 18. Note that the type info for + %% record fields has been put in a separate form. + OldAbstract = [{attribute,1,file,{"rec.erl",1}}, + {attribute,1,module,rec}, + {attribute,3,export,[{t,0}]}, + {attribute,7,record,{r,[{record_field,7,{atom,7,f}}]}}, + {attribute,7,type, + {{record,r}, + [{typed_record_field, + {record_field,7,{atom,7,f}}, + {type,7,union,[{atom,7,undefined},{type,7,atom,[]}]}}], + []}}, + {function,9,t,0,[{clause,9,[],[],[{record,10,r,[]}]}]}, + {eof,11}], + {error,[{"rec.erl",[{7,erl_lint,old_abstract_code}]}],[]} = + compile:forms(OldAbstract, [return, report]), + ok. otp_6885(doc) -> @@ -3843,40 +3868,49 @@ otp_11851(Config) when is_list(Config) -> [] = run(Config, Ts), ok. -otp_12195(doc) -> - "OTP-12195: Check obsolete types (tailor made for OTP 18)."; -otp_12195(Config) when is_list(Config) -> - Ts = [{otp_12195_1, - <<"-export_type([r1/0]). - -type r1() :: erl_scan:line() - | erl_scan:column() - | erl_scan:location() - | erl_anno:line().">>, - [], - {warnings,[{2,erl_lint, - {deprecated_type,{erl_scan,line,0}, - "deprecated (will be removed in OTP 19); " - "use erl_anno:line() instead"}}, - {3,erl_lint, - {deprecated_type,{erl_scan,column,0}, - "deprecated (will be removed in OTP 19); use " - "erl_anno:column() instead"}}, - {4,erl_lint, - {deprecated_type,{erl_scan,location,0}, - "deprecated (will be removed in OTP 19); " - "use erl_anno:location() instead"}}]}}, - {otp_12195_2, - <<"-export_type([r1/0]). - -compile(nowarn_deprecated_type). - -type r1() :: erl_scan:line() - | erl_scan:column() - | erl_scan:location() - | erl_anno:line().">>, - [], - []}], - [] = run(Config, Ts), +otp_11879(doc) -> + "OTP-11879: The -spec f/a :: (As) -> B; syntax removed, " + "and is_subtype/2 deprecated"; +otp_11879(_Config) -> + Fs = [{attribute,0,file,{"file.erl",0}}, + {attribute,0,module,m}, + {attribute,1,spec, + {{f,1}, + [{type,2,'fun',[{type,3,product,[{var,4,'V1'}, + {var,5,'V1'}]}, + {type,6,integer,[]}]}]}}, + {attribute,20,callback, + {{cb,21}, + [{type,22,'fun',[{type,23,product,[{var,24,'V1'}, + {var,25,'V1'}]}, + {type,6,integer,[]}]}]}}], + {error,[{"file.erl", + [{1,erl_lint,{spec_fun_undefined,{f,1}}}, + {2,erl_lint,spec_wrong_arity}, + {22,erl_lint,callback_wrong_arity}]}], + []} = compile:forms(Fs, [return,report]), ok. +otp_13230(doc) -> + "OTP-13230: -deprecated without -module"; +otp_13230(Config) when is_list(Config) -> + Abstr = <<"-deprecated([{frutt,0,next_version}]).">>, + {errors,[{1,erl_lint,undefined_module}, + {1,erl_lint,{bad_deprecated,{frutt,0}}}], + []} = run_test2(Config, Abstr, []), + ok. + +record_errors(Config) when is_list(Config) -> + Ts = [{rec1, + <<"-record(r, {a,b}). + b() -> #r{a=foo,b=42,a=bar}. + u(R) -> R#r{a=1,b=2,a=2}. + ">>, + [], + {errors,[{2,erl_lint,{redefine_field,r,a}}, + {3,erl_lint,{redefine_field,r,a}}],[]}}], + run(Config, Ts). + run(Config, Tests) -> F = fun({N,P,Ws,E}, BadL) -> case catch run_test(Config, P, Ws) of diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl index 92e2764c65..f7418b1f5f 100644 --- a/lib/stdlib/test/erl_pp_SUITE.erl +++ b/lib/stdlib/test/erl_pp_SUITE.erl @@ -31,7 +31,7 @@ -define(privdir, "erl_pp_SUITE_priv"). -define(t, test_server). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(datadir, ?config(data_dir, Config)). -define(privdir, ?config(priv_dir, Config)). -endif. @@ -876,6 +876,9 @@ type_examples() -> {ex30,<<"-type t99() ::" "{t2(),'\\'t::4'(),t5(),t6(),t7(),t8(),t10(),t14()," "t15(),t20(),t21(), t22(),t25()}. ">>}, + %% Writing constraints as is_subtype(V, T) is not supported since + %% Erlang/OTP 19.0, but as long as the parser recognizes the + %% is_subtype(V, T) syntax, we need a few examples of the syntax. {ex31,<<"-spec t1(FooBar :: t99()) -> t99();" "(t2()) -> t2();" "('\\'t::4'()) -> '\\'t::4'() when is_subtype('\\'t::4'(), t24);" @@ -928,7 +931,9 @@ otp_8522(Config) when is_list(Config) -> ?line {ok, _} = compile:file(FileName, [{outdir,?privdir},debug_info]), BF = filename("otp_8522", Config), ?line {ok, A} = beam_lib:chunks(BF, [abstract_code]), - ?line 5 = count_atom(A, undefined), + %% OTP-12719: Since 'undefined' is no longer added by the Erlang + %% Parser, the number of 'undefined' is 4. It used to be 5. + ?line 4 = count_atom(A, undefined), ok. count_atom(A, A) -> @@ -998,18 +1003,10 @@ otp_8567(Config) when is_list(Config) -> "t() ->\n" " 3.\n" "\n" - "-spec(t1/1 :: (ot()) -> ot1()).\n" - "t1(A) ->\n" - " A.\n" - "\n" "-spec(t2 (ot()) -> ot1()).\n" "t2(A) ->\n" " A.\n" "\n" - "-spec(otp_8567:t3/1 :: (ot()) -> ot1()).\n" - "t3(A) ->\n" - " A.\n" - "\n" "-spec(otp_8567:t4 (ot()) -> ot1()).\n" "t4(A) ->\n" " A.\n">>, @@ -1065,7 +1062,7 @@ otp_9147(Config) when is_list(Config) -> ?line {ok, Bin} = file:read_file(PFileName), %% The parentheses around "F1 :: a | b" are new (bugfix). ?line true = - lists:member("-record(undef,{f1 :: undefined | (F1 :: a | b)}).", + lists:member("-record(undef,{f1 :: F1 :: a | b}).", string:tokens(binary_to_list(Bin), "\n")), ok. diff --git a/lib/stdlib/test/erl_scan_SUITE.erl b/lib/stdlib/test/erl_scan_SUITE.erl index 12ea3d128c..941703b5dd 100644 --- a/lib/stdlib/test/erl_scan_SUITE.erl +++ b/lib/stdlib/test/erl_scan_SUITE.erl @@ -42,7 +42,7 @@ %% config(data_dir, _) -> %% ".". -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([init_per_testcase/2, end_per_testcase/2]). init_per_testcase(_Case, Config) when is_list(Config) -> @@ -191,8 +191,7 @@ otp_7810(Config) when is_list(Config) -> ?line ok = more_chars(), ?line ok = more_options(), - ?line ok = attributes_info(), - ?line ok = set_attribute(), + ?line ok = anno_info(), ok. @@ -269,7 +268,7 @@ punctuations() -> comments() -> ?line test("a %%\n b"), - {ok,[],1} = erl_scan_string("%"), + ?line {ok,[],1} = erl_scan_string("%"), ?line test("a %%\n b"), {ok,[{atom,{1,1},a},{atom,{2,2},b}],{2,3}} = erl_scan_string("a %%\n b", {1,1}), @@ -338,7 +337,7 @@ base_integers() -> erl_scan:string(Str) end || {BS,S} <- [{"3","3"},{"15","f"}, {"12","c"}] ], - {ok,[{integer,1,239},{'@',1}],1} = erl_scan_string("16#ef@"), + ?line {ok,[{integer,1,239},{'@',1}],1} = erl_scan_string("16#ef@"), {ok,[{integer,{1,1},239},{'@',{1,6}}],{1,7}} = erl_scan_string("16#ef@", {1,1}, []), {ok,[{integer,{1,1},14},{atom,{1,5},g@}],{1,7}} = @@ -387,20 +386,15 @@ dots() -> R2 = erl_scan_string(S, {1,1}, []) end || {S, R, R2} <- Dot], - ?line {ok,[{dot,_}=T1],{1,2}} = erl_scan:string(".", {1,1}, text), - ?line [{column,1},{length,1},{line,1},{text,"."}] = - erl_scan:token_info(T1, [column, length, line, text]), - ?line {ok,[{dot,_}=T2],{1,3}} = erl_scan:string(".%", {1,1}, text), - ?line [{column,1},{length,1},{line,1},{text,"."}] = - erl_scan:token_info(T2, [column, length, line, text]), - ?line {ok,[{dot,_}=T3],{1,6}} = + {ok,[{dot,_}=T1],{1,2}} = erl_scan:string(".", {1,1}, text), + [1, 1, "."] = token_info(T1), + {ok,[{dot,_}=T2],{1,3}} = erl_scan:string(".%", {1,1}, text), + [1, 1, "."] = token_info(T2), + {ok,[{dot,_}=T3],{1,6}} = erl_scan:string(".% öh", {1,1}, text), - ?line [{column,1},{length,1},{line,1},{text,"."}] = - erl_scan:token_info(T3, [column, length, line, text]), - ?line {error,{{1,2},erl_scan,char},{1,3}} = - erl_scan:string(".$", {1,1}), - ?line {error,{{1,2},erl_scan,char},{1,4}} = - erl_scan:string(".$\\", {1,1}), + [1, 1, "."] = token_info(T3), + {error,{{1,2},erl_scan,char},{1,3}} = erl_scan:string(".$", {1,1}), + {error,{{1,2},erl_scan,char},{1,4}} = erl_scan:string(".$\\", {1,1}), test_string(". ", [{dot,{1,1}}]), test_string(". ", [{dot,{1,1}}]), @@ -413,18 +407,18 @@ dots() -> test_string(".a", [{'.',{1,1}},{atom,{1,2},a}]), test_string("%. \n. ", [{dot,{2,1}}]), - ?line {more,C} = erl_scan:tokens([], "%. ",{1,1}, return), + {more,C} = erl_scan:tokens([], "%. ",{1,1}, return), {done,{ok,[{comment,{1,1},"%. "}, {white_space,{1,4},"\n"}, {dot,{2,1}}], {2,3}}, ""} = erl_scan_tokens(C, "\n. ", {1,1}, return), % any loc, any options - ?line [test_string(S, R) || - {S, R} <- [{".$\n", [{'.',{1,1}},{char,{1,2},$\n}]}, - {"$\\\n", [{char,{1,1},$\n}]}, - {"'\\\n'", [{atom,{1,1},'\n'}]}, - {"$\n", [{char,{1,1},$\n}]}] ], + [test_string(S, R) || + {S, R} <- [{".$\n", [{'.',{1,1}},{char,{1,2},$\n}]}, + {"$\\\n", [{char,{1,1},$\n}]}, + {"'\\\n'", [{atom,{1,1},'\n'}]}, + {"$\n", [{char,{1,1},$\n}]}] ], ok. chars() -> @@ -540,8 +534,8 @@ eof() -> %% A dot followed by eof is special: ?line {more, C} = erl_scan:tokens([], "a.", 1), - {done,{ok,[{atom,1,a},{dot,1}],1},eof} = erl_scan_tokens(C,eof,1), - {ok,[{atom,1,foo},{dot,1}],1} = erl_scan_string("foo."), + ?line {done,{ok,[{atom,1,a},{dot,1}],1},eof} = erl_scan_tokens(C,eof,1), + ?line {ok,[{atom,1,foo},{dot,1}],1} = erl_scan_string("foo."), %% With column. {more, CCol} = erl_scan:tokens([], "a.", {1,1}), @@ -655,145 +649,72 @@ options() -> ok. more_options() -> - ?line {ok,[{atom,A1,foo}],{19,20}} = + {ok,[{atom,_,foo}=T1],{19,20}} = erl_scan:string("foo", {19,17},[]), - ?line [{column,17},{line,19}] = erl_scan:attributes_info(A1), - ?line {done,{ok,[{atom,A2,foo},{dot,_}],{19,22}},[]} = + {19,17} = erl_scan:location(T1), + {done,{ok,[{atom,_,foo}=T2,{dot,_}],{19,22}},[]} = erl_scan:tokens([], "foo. ", {19,17}, [bad_opt]), % type error - ?line [{column,17},{line,19}] = erl_scan:attributes_info(A2), - ?line {ok,[{atom,A3,foo}],{19,20}} = + {19,17} = erl_scan:location(T2), + {ok,[{atom,_,foo}=T3],{19,20}} = erl_scan:string("foo", {19,17},[text]), - ?line [{column,17},{length,3},{line,19},{text,"foo"}] = - erl_scan:attributes_info(A3), + {19,17} = erl_scan:location(T3), + "foo" = erl_scan:text(T3), - ?line {ok,[{atom,A4,foo}],1} = erl_scan:string("foo", 1, [text]), - ?line [{length,3},{line,1},{text,"foo"}] = erl_scan:attributes_info(A4), + {ok,[{atom,_,foo}=T4],1} = erl_scan:string("foo", 1, [text]), + 1 = erl_scan:line(T4), + 1 = erl_scan:location(T4), + "foo" = erl_scan:text(T4), ok. token_info() -> - ?line {ok,[T1],_} = erl_scan:string("foo", {1,18}, [text]), + {ok,[T1],_} = erl_scan:string("foo", {1,18}, [text]), {'EXIT',{badarg,_}} = - (catch {foo, erl_scan:token_info(T1, foo)}), % type error - ?line {line,1} = erl_scan:token_info(T1, line), - ?line {column,18} = erl_scan:token_info(T1, column), - ?line {length,3} = erl_scan:token_info(T1, length), - ?line {text,"foo"} = erl_scan:token_info(T1, text), - ?line [{category,atom},{column,18},{length,3},{line,1}, - {symbol,foo},{text,"foo"}] = - erl_scan:token_info(T1), - ?line [{length,3},{column,18}] = - erl_scan:token_info(T1, [length, column]), - ?line [{location,{1,18}}] = - erl_scan:token_info(T1, [location]), - ?line {category,atom} = erl_scan:token_info(T1, category), - ?line [{symbol,foo}] = erl_scan:token_info(T1, [symbol]), - - ?line {ok,[T2],_} = erl_scan:string("foo", 1, []), - ?line {line,1} = erl_scan:token_info(T2, line), - ?line undefined = erl_scan:token_info(T2, column), - ?line undefined = erl_scan:token_info(T2, length), - ?line undefined = erl_scan:token_info(T2, text), - ?line {location,1} = erl_scan:token_info(T2, location), - ?line [{category,atom},{line,1},{symbol,foo}] = erl_scan:token_info(T2), - ?line [{line,1}] = erl_scan:token_info(T2, [length, line]), - - ?line {ok,[T3],_} = erl_scan:string("=", 1, []), - ?line [{line,1}] = erl_scan:token_info(T3, [column, line]), - ?line {category,'='} = erl_scan:token_info(T3, category), - ?line [{symbol,'='}] = erl_scan:token_info(T3, [symbol]), + (catch {foo, erl_scan:category(foo)}), % type error + {'EXIT',{badarg,_}} = + (catch {foo, erl_scan:symbol(foo)}), % type error + atom = erl_scan:category(T1), + foo = erl_scan:symbol(T1), + + {ok,[T2],_} = erl_scan:string("foo", 1, []), + 1 = erl_scan:line(T2), + undefined = erl_scan:column(T2), + undefined = erl_scan:text(T2), + 1 = erl_scan:location(T2), + + {ok,[T3],_} = erl_scan:string("=", 1, []), + '=' = erl_scan:category(T3), + '=' = erl_scan:symbol(T3), ok. -attributes_info() -> - ?line {'EXIT',_} = - (catch {foo,erl_scan:attributes_info(foo)}), % type error - [{line,18}] = erl_scan:attributes_info(erl_anno:new(18)), - {location,19} = - erl_scan:attributes_info(erl_anno:new(19), location), - ?line {ok,[{atom,A0,foo}],_} = erl_scan:string("foo", 19, [text]), - ?line {location,19} = erl_scan:attributes_info(A0, location), - - ?line {ok,[{atom,A3,foo}],_} = erl_scan:string("foo", {1,3}, [text]), - ?line {line,1} = erl_scan:attributes_info(A3, line), - ?line {column,3} = erl_scan:attributes_info(A3, column), - ?line {location,{1,3}} = erl_scan:attributes_info(A3, location), - ?line {text,"foo"} = erl_scan:attributes_info(A3, text), - - ?line {ok,[{atom,A4,foo}],_} = erl_scan:string("foo", 2, [text]), - ?line {line,2} = erl_scan:attributes_info(A4, line), - ?line undefined = erl_scan:attributes_info(A4, column), - ?line {location,2} = erl_scan:attributes_info(A4, location), - ?line {text,"foo"} = erl_scan:attributes_info(A4, text), - - ?line {ok,[{atom,A5,foo}],_} = erl_scan:string("foo", {1,3}, []), - ?line {line,1} = erl_scan:attributes_info(A5, line), - ?line {column,3} = erl_scan:attributes_info(A5, column), - ?line {location,{1,3}} = erl_scan:attributes_info(A5, location), - ?line undefined = erl_scan:attributes_info(A5, text), - - ?line undefined = erl_scan:attributes_info([], line), % type error +anno_info() -> + {'EXIT',_} = + (catch {foo,erl_scan:line(foo)}), % type error + {ok,[{atom,_,foo}=T0],_} = erl_scan:string("foo", 19, [text]), + 19 = erl_scan:location(T0), + 19 = erl_scan:end_location(T0), + + {ok,[{atom,_,foo}=T3],_} = erl_scan:string("foo", {1,3}, [text]), + 1 = erl_scan:line(T3), + 3 = erl_scan:column(T3), + {1,3} = erl_scan:location(T3), + {1,6} = erl_scan:end_location(T3), + "foo" = erl_scan:text(T3), + + {ok,[{atom,_,foo}=T4],_} = erl_scan:string("foo", 2, [text]), + 2 = erl_scan:line(T4), + undefined = erl_scan:column(T4), + 2 = erl_scan:location(T4), + "foo" = erl_scan:text(T4), + + {ok,[{atom,_,foo}=T5],_} = erl_scan:string("foo", {1,3}, []), + 1 = erl_scan:line(T5), + 3 = erl_scan:column(T5), + {1,3} = erl_scan:location(T5), + undefined = erl_scan:text(T5), ok. -set_attribute() -> - F = fun(Line) -> -Line end, - Anno2 = erl_anno:new(2), - A0 = erl_scan:set_attribute(line, Anno2, F), - {line, -2} = erl_scan:attributes_info(A0, line), - ?line {ok,[{atom,A1,foo}],_} = erl_scan:string("foo", {9,17}), - ?line A2 = erl_scan:set_attribute(line, A1, F), - ?line {line,-9} = erl_scan:attributes_info(A2, line), - ?line {location,{-9,17}} = erl_scan:attributes_info(A2, location), - ?line [{line,-9},{column,17}] = - erl_scan:attributes_info(A2, [line,column,text]), - - F2 = fun(Line) -> {17,Line} end, - ?line Attr1 = erl_scan:set_attribute(line, 2, F2), - ?line {line,{17,2}} = erl_scan:attributes_info(Attr1, line), - ?line undefined = erl_scan:attributes_info(Attr1, column), - ?line {location,{17,2}} = % a bit mixed up - erl_scan:attributes_info(Attr1, location), - - ?line A3 = erl_scan:set_attribute(line, A1, F2), - ?line {line,{17,9}} = erl_scan:attributes_info(A3, line), - ?line {location,{{17,9},17}} = erl_scan:attributes_info(A3, location), - ?line [{line,{17,9}},{column,17}] = - erl_scan:attributes_info(A3, [line,column,text]), - - ?line {ok,[{atom,A4,foo}],_} = erl_scan:string("foo", {9,17}, [text]), - ?line A5 = erl_scan:set_attribute(line, A4, F), - ?line {line,-9} = erl_scan:attributes_info(A5, line), - ?line {location,{-9,17}} = erl_scan:attributes_info(A5, location), - ?line [{line,-9},{column,17},{text,"foo"}] = - erl_scan:attributes_info(A5, [line,column,text]), - - ?line {ok,[{atom,A6,foo}],_} = erl_scan:string("foo", 11, [text]), - ?line A7 = erl_scan:set_attribute(line, A6, F2), - %% Incompatible with pre 18: - %% {line,{17,11}} = erl_scan:attributes_info(A7, line), - {line,17} = erl_scan:attributes_info(A7, line), - ?line {location,{17,11}} = % mixed up - erl_scan:attributes_info(A7, location), - %% Incompatible with pre 18: - %% [{line,{17,11}},{text,"foo"}] = - %% erl_scan:attributes_info(A7, [line,column,text]), - [{line,17},{column,11},{text,"foo"}] = - erl_scan:attributes_info(A7, [line,column,text]), - - ?line {'EXIT',_} = - (catch {foo, erl_scan:set_attribute(line, [], F2)}), % type error - ?line {'EXIT',{badarg,_}} = - (catch {foo, erl_scan:set_attribute(column, [], F2)}), % type error - - Attr10 = erl_anno:new(8), - Attr20 = erl_scan:set_attribute(line, Attr10, - fun(L) -> {nos,'X',L} end), - %% OTP-9412 - Attr30 = erl_scan:set_attribute(line, Attr20, - fun({nos,_V,VL}) -> VL end), - 8 = erl_anno:to_term(Attr30), - ok. - column_errors() -> ?line {error,{{1,1},erl_scan,{string,$',""}},{1,3}} = % $' erl_scan:string("'\\",{1,1}), @@ -892,14 +813,13 @@ unicode() -> erl_scan_string(Qs, 1), {ok,[Q2],{1,9}} = erl_scan:string("$\\x{aaa}", {1,1}, [text]), - [{category,char},{column,1},{length,8}, - {line,1},{symbol,16#aaa},{text,Qs}] = - erl_scan:token_info(Q2), + [{category,char},{column,1},{line,1},{symbol,16#aaa},{text,Qs}] = + token_info_long(Q2), U1 = "\"\\x{aaa}\"", - {ok,[{string,A1,[2730]}],{1,10}} = erl_scan:string(U1, {1,1}, [text]), - [{line,1},{column,1},{text,"\"\\x{aaa}\""}] = - erl_scan:attributes_info(A1, [line, column, text]), + {ok,[{string,_,[2730]}=T1],{1,10}} = erl_scan:string(U1, {1,1}, [text]), + {1,1} = erl_scan:location(T1), + "\"\\x{aaa}\"" = erl_scan:text(T1), {ok,[{string,1,[2730]}],1} = erl_scan_string(U1, 1), U2 = "\"\\x41\\x{fff}\\x42\"", @@ -1012,16 +932,13 @@ otp_10302(Config) when is_list(Config) -> Qs = "$\\x{aaa}", {ok,[{char,1,2730}],1} = erl_scan_string(Qs, 1), {ok,[Q2],{1,9}} = erl_scan:string(Qs,{1,1},[text]), - [{category,char},{column,1},{length,8}, - {line,1},{symbol,16#aaa},{text,Qs}] = - erl_scan:token_info(Q2), - - Tags = [category, column, length, line, symbol, text], + [{category,char},{column,1},{line,1},{symbol,16#aaa},{text,Qs}] = + token_info_long(Q2), U1 = "\"\\x{aaa}\"", {ok,[T1],{1,10}} = erl_scan:string(U1, {1,1}, [text]), - [{category,string},{column,1},{length,9},{line,1}, - {symbol,[16#aaa]},{text,U1}] = erl_scan:token_info(T1, Tags), + [{category,string},{column,1},{line,1},{symbol,[16#aaa]},{text,U1}] = + token_info_long(T1), U2 = "\"\\x41\\x{fff}\\x42\"", {ok,[{string,1,[65,4095,66]}],1} = erl_scan_string(U2, 1), @@ -1353,9 +1270,7 @@ test_wsc([], []) -> ok; test_wsc([Token|Tokens], [Token2|Tokens2]) -> [Text, Text2] = [Text || - {text, Text} <- - [erl_scan:token_info(T, text) || - T <- [Token, Token2]]], + Text <- [erl_scan:text(T) || T <- [Token, Token2]]], Sz = erts_debug:size(Text), Sz2 = erts_debug:size({Text, Text2}), IsCompacted = Sz2 < 2*Sz+erts_debug:size({a,a}), @@ -1394,7 +1309,7 @@ all_same(L, Char) -> newlines_first([]) -> ok; newlines_first([Token|Tokens]) -> - {text,Text} = erl_scan:token_info(Token, text), + Text = erl_scan:text(Token), Nnls = length([C || C <- Text, C =:= $\n]), OK = case Text of [$\n|_] -> @@ -1414,7 +1329,7 @@ select_tokens(Tokens, Tags) -> lists:filter(fun(T) -> lists:member(element(1, T), Tags) end, Tokens). simplify([Token|Tokens]) -> - {line,Line} = erl_scan:token_info(Token, line), + Line = erl_scan:line(Token), [setelement(2, Token, erl_anno:new(Line)) | simplify(Tokens)]; simplify([]) -> []. @@ -1423,17 +1338,31 @@ get_text(Tokens) -> lists:flatten( [T || Token <- Tokens, - ({text,T} = erl_scan:token_info(Token, text)) =/= []]). + (T = erl_scan:text(Token)) =/= []]). test_decorated_tokens(String, Tokens) -> ToksAttrs = token_attrs(Tokens), test_strings(ToksAttrs, String, 1, 1). token_attrs(Tokens) -> - [{L,C,Len,T} || + [{L,C,length(T),T} || Token <- Tokens, - ([{line,L},{column,C},{length,Len},{text,T}] = - erl_scan:token_info(Token, [line,column,length,text])) =/= []]. + ([C,L,T] = token_info(Token)) =/= []]. + +token_info(T) -> + Column = erl_scan:column(T), + Line = erl_scan:line(T), + Text = erl_scan:text(T), + [Column, Line, Text]. + +token_info_long(T) -> + Column = erl_scan:column(T), + Line = erl_scan:line(T), + Text = erl_scan:text(T), + Category = erl_scan:category(T), + Symbol = erl_scan:symbol(T), + [{category,Category},{column,Column},{line,Line}, + {symbol,Symbol},{text,Text}]. test_strings([], _S, Line, Column) -> {Line,Column}; @@ -1514,8 +1443,7 @@ consistent_attributes([Ts | TsL]) -> L = [T || T <- Ts, is_integer(element(2, T))], case L of [] -> - TagsL = [[Tag || {Tag,_} <- - erl_scan:attributes_info(element(2, T))] || + TagsL = [[Tag || {Tag,_} <- defined(token_info_long(T))] || T <- Ts], case lists:usort(TagsL) of [_] -> @@ -1531,6 +1459,9 @@ consistent_attributes([Ts | TsL]) -> Ts end. +defined(L) -> + [{T,V} || {T,V} <- L, V =/= undefined]. + family_list(L) -> sofs:to_external(family(L)). diff --git a/lib/stdlib/test/error_logger_h_SUITE.erl b/lib/stdlib/test/error_logger_h_SUITE.erl index c82b1b62ef..b2f1618ff5 100644 --- a/lib/stdlib/test/error_logger_h_SUITE.erl +++ b/lib/stdlib/test/error_logger_h_SUITE.erl @@ -25,7 +25,7 @@ %% Event handler exports. -export([init/1,handle_event/2,terminate/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/stdlib/test/escript_SUITE.erl b/lib/stdlib/test/escript_SUITE.erl index 87ff6a68ff..a8d646c044 100644 --- a/lib/stdlib/test/escript_SUITE.erl +++ b/lib/stdlib/test/escript_SUITE.erl @@ -40,7 +40,7 @@ unicode/1 ]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index ae431d66d9..6f9be9b179 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -107,14 +107,13 @@ -export([t_select_reverse/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(m(A,B), ?line assert_eq(A,B)). init_per_testcase(Case, Config) -> - Seed = {S1,S2,S3} = random:seed0(), %now(), - random:seed(S1,S2,S3), - io:format("*** SEED: ~p ***\n", [Seed]), + rand:seed(exsplus), + io:format("*** SEED: ~p ***\n", [rand:export_seed()]), start_spawn_logger(), wait_for_test_procs(), %% Ensure previous case cleaned up Dog=test_server:timetrap(test_server:minutes(20)), @@ -731,10 +730,6 @@ chk_normal_tab_struct_size() -> % ?line ok % end. --define(DB_TREE_STACK_NEED,50). % The static stack for a tree, in halfword pointers are two internal words - % so the stack gets twice as big --define(DB_HASH_SIZEOF_EXTSEG,260). % The segment size in words, in halfword this will be twice as large. - adjust_xmem([T1,T2,T3,T4], {A0,B0,C0,D0} = _Mem0) -> %% Adjust for 64-bit, smp, and os: %% Table struct size may differ. @@ -748,19 +743,7 @@ adjust_xmem([T1,T2,T3,T4], {A0,B0,C0,D0} = _Mem0) -> % end, TabDiff = ?TAB_STRUCT_SZ, - Mem1 = {A0+TabDiff, B0+TabDiff, C0+TabDiff, D0+TabDiff}, - - case {erlang:system_info({wordsize,internal}),erlang:system_info({wordsize,external})} of - %% Halfword, corrections for regular pointers occupying two internal words. - {4,8} -> - {A1,B1,C1,D1} = Mem1, - {A1+4*ets:info(T1, size)+?DB_TREE_STACK_NEED, - B1+3*ets:info(T2, size)+?DB_HASH_SIZEOF_EXTSEG, - C1+3*ets:info(T3, size)+?DB_HASH_SIZEOF_EXTSEG, - D1+3*ets:info(T4, size)+?DB_HASH_SIZEOF_EXTSEG}; - _ -> - Mem1 - end. + {A0+TabDiff, B0+TabDiff, C0+TabDiff, D0+TabDiff}. t_whitebox(doc) -> ["Diverse whitebox testes"]; @@ -1346,7 +1329,7 @@ drop_match() -> ets_match(Tab,Expr) -> - case random:uniform(2) of + case rand:uniform(2) of 1 -> ets:match(Tab,Expr); _ -> @@ -1355,14 +1338,14 @@ ets_match(Tab,Expr) -> match_chunked(Tab,Expr) -> match_chunked_collect(ets:match(Tab,Expr, - random:uniform(1999) + 1)). + rand:uniform(1999) + 1)). match_chunked_collect('$end_of_table') -> []; match_chunked_collect({Results, Continuation}) -> Results ++ match_chunked_collect(ets:match(Continuation)). ets_match_object(Tab,Expr) -> - case random:uniform(2) of + case rand:uniform(2) of 1 -> ets:match_object(Tab,Expr); _ -> @@ -1371,7 +1354,7 @@ ets_match_object(Tab,Expr) -> match_object_chunked(Tab,Expr) -> match_object_chunked_collect(ets:match_object(Tab,Expr, - random:uniform(1999) + 1)). + rand:uniform(1999) + 1)). match_object_chunked_collect('$end_of_table') -> []; match_object_chunked_collect({Results, Continuation}) -> @@ -1383,19 +1366,15 @@ random_test() -> ?line ReadDir = get(where_to_read), ?line WriteDir = get(where_to_write), ?line (catch file:make_dir(WriteDir)), - ?line Seed = case file:consult(filename:join([ReadDir, - "preset_random_seed.txt"])) of - {ok,[X]} -> - X; - _ -> - {A,B,C} = erlang:timestamp(), - random:seed(A,B,C), - get(random_seed) - end, - put(random_seed,Seed), - ?line {ok, F} = file:open(filename:join([WriteDir, - "last_random_seed.txt"]), - [write]), + case file:consult(filename:join([ReadDir,"preset_random_seed.txt"])) of + {ok,[X]} -> + rand:seed(X); + _ -> + rand:seed(exsplus) + end, + Seed = rand:export_seed(), + {ok,F} = file:open(filename:join([WriteDir,"last_random_seed.txt"]), + [write]), io:format(F,"~p. ~n",[Seed]), file:close(F), io:format("Random seed ~p written to ~s, copy to ~s to rerun with " @@ -1417,7 +1396,7 @@ do_random_test() -> end, 5000), ?line io:format("~nData inserted~n"), ?line do_n_times(fun() -> - ?line I = random:uniform(25), + I = rand:uniform(25), ?line Key = create_random_string(I) ++ '_', ?line L1 = ets_match_object(OrdSet,{Key,'_'}), ?line L2 = lists:sort(ets_match_object(Set,{Key,'_'})), @@ -1977,7 +1956,7 @@ evil_update_counter(Config) when is_list(Config) -> gb_sets:module_info(), math:module_info(), ordsets:module_info(), - random:module_info(), + rand:module_info(), repeat_for_opts(evil_update_counter_do). @@ -2011,7 +1990,7 @@ evil_counter(I,Opts) -> 1 -> 16#12345678FFFFFFFF; 2 -> 16#7777777777FFFFFFFF863648726743 end, - Start = Start0 + random:uniform(100000), + Start = Start0 + rand:uniform(100000), ets:insert(T, {dracula,Start}), Iter = 40000, End = Start + Iter, @@ -3989,15 +3968,37 @@ safe_fixtable_do(Opts) -> ?line true = ets:safe_fixtable(Tab, true), ?line receive after 1 -> ok end, ?line true = ets:safe_fixtable(Tab, false), - ?line false = ets:info(Tab,safe_fixed), - ?line true = ets:safe_fixtable(Tab, true), + false = ets:info(Tab,safe_fixed_monotonic_time), + false = ets:info(Tab,safe_fixed), + SysBefore = erlang:timestamp(), + MonBefore = erlang:monotonic_time(), + true = ets:safe_fixtable(Tab, true), + MonAfter = erlang:monotonic_time(), + SysAfter = erlang:timestamp(), Self = self(), - ?line {{_,_,_},[{Self,1}]} = ets:info(Tab,safe_fixed), + {FixMonTime,[{Self,1}]} = ets:info(Tab,safe_fixed_monotonic_time), + {FixSysTime,[{Self,1}]} = ets:info(Tab,safe_fixed), + true = is_integer(FixMonTime), + true = MonBefore =< FixMonTime, + true = FixMonTime =< MonAfter, + {FstMs,FstS,FstUs} = FixSysTime, + true = is_integer(FstMs), + true = is_integer(FstS), + true = is_integer(FstUs), + case erlang:system_info(time_warp_mode) of + no_time_warp -> + true = timer:now_diff(FixSysTime, SysBefore) >= 0, + true = timer:now_diff(SysAfter, FixSysTime) >= 0; + _ -> + %% ets:info(Tab,safe_fixed) not timewarp safe... + ignore + end, %% Test that an unjustified 'unfix' is a no-op. {Pid,MRef} = my_spawn_monitor(fun() -> true = ets:safe_fixtable(Tab,false) end), {'DOWN', MRef, process, Pid, normal} = receive M -> M end, - ?line true = ets:info(Tab,fixed), - ?line {{_,_,_},[{Self,1}]} = ets:info(Tab,safe_fixed), + true = ets:info(Tab,fixed), + {FixMonTime,[{Self,1}]} = ets:info(Tab,safe_fixed_monotonic_time), + {FixSysTime,[{Self,1}]} = ets:info(Tab,safe_fixed), %% badarg's ?line {'EXIT', {badarg, _}} = (catch ets:safe_fixtable(Tab, foobar)), ?line true = ets:info(Tab,fixed), @@ -4043,6 +4044,7 @@ info_do(Opts) -> ?line undefined = ets:info(non_existing_table_xxyy,type), ?line undefined = ets:info(non_existing_table_xxyy,node), ?line undefined = ets:info(non_existing_table_xxyy,named_table), + ?line undefined = ets:info(non_existing_table_xxyy,safe_fixed_monotonic_time), ?line undefined = ets:info(non_existing_table_xxyy,safe_fixed), ?line verify_etsmem(EtsMem). @@ -4661,11 +4663,11 @@ create_random_string(0) -> []; create_random_string(OfLength) -> - C = case random:uniform(2) of + C = case rand:uniform(2) of 1 -> - (random:uniform($Z - $A + 1) - 1) + $A; + (rand:uniform($Z - $A + 1) - 1) + $A; _ -> - (random:uniform($z - $a + 1) - 1) + $a + (rand:uniform($z - $a + 1) - 1) + $a end, [C | create_random_string(OfLength - 1)]. @@ -4676,7 +4678,7 @@ create_random_tuple(OfLength) -> end,create_random_string(OfLength))). create_partly_bound_tuple(OfLength) -> - case random:uniform(2) of + case rand:uniform(2) of 1 -> create_partly_bound_tuple1(OfLength); _ -> @@ -4685,14 +4687,14 @@ create_partly_bound_tuple(OfLength) -> create_partly_bound_tuple1(OfLength) -> T0 = create_random_tuple(OfLength), - I = random:uniform(OfLength), + I = rand:uniform(OfLength), setelement(I,T0,'$1'). set_n_random_elements(T0,0,_,_) -> T0; set_n_random_elements(T0,N,OfLength,GenFun) -> - I = random:uniform(OfLength), + I = rand:uniform(OfLength), What = GenFun(I), case element(I,T0) of What -> @@ -4706,12 +4708,12 @@ make_dollar_atom(I) -> list_to_atom([$$] ++ integer_to_list(I)). create_partly_bound_tuple2(OfLength) -> T0 = create_random_tuple(OfLength), - I = random:uniform(OfLength - 1), + I = rand:uniform(OfLength - 1), set_n_random_elements(T0,I,OfLength,fun make_dollar_atom/1). create_partly_bound_tuple3(OfLength) -> T0 = create_random_tuple(OfLength), - I = random:uniform(OfLength - 1), + I = rand:uniform(OfLength - 1), set_n_random_elements(T0,I,OfLength,fun(_) -> '_' end). do_n_times(_,0) -> @@ -5074,11 +5076,12 @@ meta_wb_do(Opts) -> io:format("Colliding names = ~p\n",[Names]), F = fun(0,_,_) -> ok; - (N,Tabs,Me) -> Name1 = lists:nth(random:uniform(Len),Names), - Name2 = lists:nth(random:uniform(Len),Names), - Op = element(random:uniform(3),OpFuns), - NTabs = Op(Name1, Name2, Tabs, Opts), - Me(N-1,NTabs,Me) + (N,Tabs,Me) -> + Name1 = lists:nth(rand:uniform(Len), Names), + Name2 = lists:nth(rand:uniform(Len), Names), + Op = element(rand:uniform(3),OpFuns), + NTabs = Op(Name1, Name2, Tabs, Opts), + Me(N-1, NTabs, Me) end, F(Len*100, [], F), @@ -5344,7 +5347,7 @@ smp_insert(suite) -> []; smp_insert(Config) when is_list(Config) -> ets_new(smp_insert,[named_table,public,{write_concurrency,true}]), InitF = fun(_) -> ok end, - ExecF = fun(_) -> true = ets:insert(smp_insert,{random:uniform(10000)}) + ExecF = fun(_) -> true = ets:insert(smp_insert,{rand:uniform(10000)}) end, FiniF = fun(_) -> ok end, run_workers(InitF,ExecF,FiniF,100000), @@ -5532,7 +5535,7 @@ otp_8166_zombie_creator(T,Deleted) -> [{'=<','$1', Deleted}], [true]}]), Pid ! zombies_created, - repeat_while(fun() -> case ets:info(T,safe_fixed) of + repeat_while(fun() -> case ets:info(T,safe_fixed_monotonic_time) of {_,[_P1,_P2]} -> false; _ -> @@ -5595,10 +5598,10 @@ smp_select_delete(Config) when is_list(Config) -> Zeros = erlang:make_tuple(Mod,0), InitF = fun(_) -> Zeros end, ExecF = fun(Diffs0) -> - case random:uniform(20) of + case rand:uniform(20) of 1 -> Mod = 17, - Eq = random:uniform(Mod) - 1, + Eq = rand:uniform(Mod) - 1, Deleted = ets:select_delete(T, [{{'_', '$1'}, [{'=:=', {'rem', '$1', Mod}, Eq}], @@ -5607,7 +5610,7 @@ smp_select_delete(Config) when is_list(Config) -> element(Eq+1,Diffs0) - Deleted), Diffs1; _ -> - Key = random:uniform(10000), + Key = rand:uniform(10000), Eq = Key rem Mod, ?line case ets:insert_new(T,{Key,Key}) of true -> @@ -5811,7 +5814,7 @@ run_workers_do(InitF,ExecF,FiniF,Laps, Exclude) -> N when (N > Exclude) -> N - Exclude end, io:format("smp starting ~p workers\n",[NumOfProcs]), - Seeds = [{ProcN,random:uniform(9999)} || ProcN <- lists:seq(1,NumOfProcs)], + Seeds = [{ProcN,rand:uniform(9999)} || ProcN <- lists:seq(1,NumOfProcs)], Parent = self(), Pids = [my_spawn_link(fun()-> worker(Seed,InitF,ExecF,FiniF,Laps,Parent,NumOfProcs) end) || Seed <- Seeds], @@ -5822,7 +5825,7 @@ run_workers_do(InitF,ExecF,FiniF,Laps, Exclude) -> worker({ProcN,Seed}, InitF, ExecF, FiniF, Laps, Parent, NumOfProcs) -> io:format("smp worker ~p, seed=~p~n",[self(),Seed]), - random:seed(Seed,Seed,Seed), + rand:seed(exsplus, {Seed,Seed,Seed}), State1 = InitF([ProcN, NumOfProcs]), State2 = worker_loop(Laps, ExecF, State1), Result = FiniF(State2), diff --git a/lib/stdlib/test/ets_tough_SUITE.erl b/lib/stdlib/test/ets_tough_SUITE.erl index c6f24fc670..5c2ab4747c 100644 --- a/lib/stdlib/test/ets_tough_SUITE.erl +++ b/lib/stdlib/test/ets_tough_SUITE.erl @@ -23,7 +23,7 @@ -export([init/1,terminate/2,handle_call/3,handle_info/2]). -export([init_per_testcase/2, end_per_testcase/2]). -compile([export_all]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -92,7 +92,7 @@ ex1_sub(Config) -> ok. prep(Config) -> - random:seed(), + rand:seed(exsplus), put(dump_ticket,none), DumpDir = filename:join(?config(priv_dir,Config), "ets_tough"), file:make_dir(DumpDir), @@ -221,19 +221,19 @@ random_class() -> random_element(Classes). random_key() -> - random:uniform(8). + rand:uniform(8). random_value() -> - case random:uniform(5) of + case rand:uniform(5) of 1 -> ok; 2 -> {data,random_key()}; 3 -> {foo,bar,random_class()}; - 4 -> random:uniform(1000); + 4 -> rand:uniform(1000); 5 -> {recursive,random_value()} end. random_element(T) -> - I = random:uniform(tuple_size(T)), + I = rand:uniform(tuple_size(T)), element(I,T). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/stdlib/test/file_sorter_SUITE.erl b/lib/stdlib/test/file_sorter_SUITE.erl index e0d9ec1fd7..947dc2ad8d 100644 --- a/lib/stdlib/test/file_sorter_SUITE.erl +++ b/lib/stdlib/test/file_sorter_SUITE.erl @@ -28,7 +28,7 @@ -define(t,test_server). -define(privdir(_), "./file_sorter_SUITE_priv"). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(format(S, A), ok). -define(privdir(Conf), ?config(priv_dir, Conf)). -endif. diff --git a/lib/stdlib/test/filelib_SUITE.erl b/lib/stdlib/test/filelib_SUITE.erl index 01b798faef..5d5434c7b2 100644 --- a/lib/stdlib/test/filelib_SUITE.erl +++ b/lib/stdlib/test/filelib_SUITE.erl @@ -29,7 +29,7 @@ -import(lists, [foreach/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). init_per_testcase(_Case, Config) -> @@ -318,7 +318,7 @@ same_lists(Expected0, Actual0, BaseDir) -> mkfiles([H|T], Dir) -> Name = filename:join(Dir, H), - Garbage = [31+random:uniform(95) || _ <- lists:seq(1, random:uniform(1024))], + Garbage = [31+rand:uniform(95) || _ <- lists:seq(1, rand:uniform(1024))], file:write_file(Name, Garbage), [Name|mkfiles(T, Dir)]; mkfiles([], _) -> []. diff --git a/lib/stdlib/test/filename_SUITE.erl b/lib/stdlib/test/filename_SUITE.erl index fd47da8150..8ecbc7eadf 100644 --- a/lib/stdlib/test/filename_SUITE.erl +++ b/lib/stdlib/test/filename_SUITE.erl @@ -29,7 +29,7 @@ dirname_bin/1, extension_bin/1, join_bin/1, t_nativename_bin/1]). -export([pathtype_bin/1,rootname_bin/1,split_bin/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -97,20 +97,11 @@ absname(Config) when is_list(Config) -> ?line file:set_cwd(Cwd), ok; - Type -> - case Type of - {unix, _} -> - ?line ok = file:set_cwd("/usr"), - ?line "/usr/foo" = filename:absname(foo), - ?line "/usr/foo" = filename:absname("foo"), - ?line "/usr/../ebin" = filename:absname("../ebin"); - {ose, _} -> - ?line ok = file:set_cwd("/romfs"), - ?line "/romfs/foo" = filename:absname(foo), - ?line "/romfs/foo" = filename:absname("foo"), - ?line "/romfs/../ebin" = filename:absname("../ebin") - end, - + {unix, _} -> + ?line ok = file:set_cwd("/usr"), + ?line "/usr/foo" = filename:absname(foo), + ?line "/usr/foo" = filename:absname("foo"), + ?line "/usr/../ebin" = filename:absname("../ebin"), ?line file:set_cwd("/"), ?line "/foo" = filename:absname(foo), ?line "/foo" = filename:absname("foo"), @@ -494,18 +485,10 @@ absname_bin(Config) when is_list(Config) -> ?line file:set_cwd(Cwd), ok; - Type -> - case Type of - {unix,_} -> - ?line ok = file:set_cwd(<<"/usr">>), - ?line <<"/usr/foo">> = filename:absname(<<"foo">>), - ?line <<"/usr/../ebin">> = filename:absname(<<"../ebin">>); - {ose,_} -> - ?line ok = file:set_cwd(<<"/romfs">>), - ?line <<"/romfs/foo">> = filename:absname(<<"foo">>), - ?line <<"/romfs/../ebin">> = filename:absname(<<"../ebin">>) - end, - + {unix, _} -> + ?line ok = file:set_cwd(<<"/usr">>), + ?line <<"/usr/foo">> = filename:absname(<<"foo">>), + ?line <<"/usr/../ebin">> = filename:absname(<<"../ebin">>), ?line file:set_cwd(<<"/">>), ?line <<"/foo">> = filename:absname(<<"foo">>), ?line <<"/../ebin">> = filename:absname(<<"../ebin">>), diff --git a/lib/stdlib/test/fixtable_SUITE.erl b/lib/stdlib/test/fixtable_SUITE.erl index cf716032a1..66150e60c1 100644 --- a/lib/stdlib/test/fixtable_SUITE.erl +++ b/lib/stdlib/test/fixtable_SUITE.erl @@ -56,7 +56,7 @@ end_per_group(_GroupName, Config) -> Config. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %%% I wrote this thinking I would use more than one temporary at a time, but %%% I wasn't... Well, maybe in the future... diff --git a/lib/stdlib/test/format_SUITE.erl b/lib/stdlib/test/format_SUITE.erl index 77636687cd..da28e085bb 100644 --- a/lib/stdlib/test/format_SUITE.erl +++ b/lib/stdlib/test/format_SUITE.erl @@ -25,7 +25,7 @@ -export([init_per_testcase/2, end_per_testcase/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). % Default timetrap timeout (set in init_per_testcase). -define(default_timeout, ?t:minutes(1)). diff --git a/lib/stdlib/test/gen_event_SUITE.erl b/lib/stdlib/test/gen_event_SUITE.erl index b019f98b69..e14f057720 100644 --- a/lib/stdlib/test/gen_event_SUITE.erl +++ b/lib/stdlib/test/gen_event_SUITE.erl @@ -19,7 +19,7 @@ %% -module(gen_event_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). diff --git a/lib/stdlib/test/gen_fsm_SUITE.erl b/lib/stdlib/test/gen_fsm_SUITE.erl index e3da1a2271..c238232ef0 100644 --- a/lib/stdlib/test/gen_fsm_SUITE.erl +++ b/lib/stdlib/test/gen_fsm_SUITE.erl @@ -19,7 +19,7 @@ %% -module(gen_fsm_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Test cases -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/lib/stdlib/test/gen_server_SUITE.erl b/lib/stdlib/test/gen_server_SUITE.erl index 0ae763a48d..634d868ad4 100644 --- a/lib/stdlib/test/gen_server_SUITE.erl +++ b/lib/stdlib/test/gen_server_SUITE.erl @@ -19,7 +19,7 @@ %% -module(gen_server_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/inet.hrl"). -export([init_per_testcase/2, end_per_testcase/2]). diff --git a/lib/stdlib/test/id_transform_SUITE.erl b/lib/stdlib/test/id_transform_SUITE.erl index 1cff990697..a0c3c9317a 100644 --- a/lib/stdlib/test/id_transform_SUITE.erl +++ b/lib/stdlib/test/id_transform_SUITE.erl @@ -31,7 +31,7 @@ % Serves as test... -hej(hopp). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/stdlib/test/io_SUITE.erl b/lib/stdlib/test/io_SUITE.erl index 0e897631ff..821673559b 100644 --- a/lib/stdlib/test/io_SUITE.erl +++ b/lib/stdlib/test/io_SUITE.erl @@ -46,7 +46,7 @@ -define(t, test_server). -define(privdir(_), "./io_SUITE_priv"). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(format(S, A), ok). -define(privdir(Conf), ?config(priv_dir, Conf)). -endif. diff --git a/lib/stdlib/test/io_proto_SUITE.erl b/lib/stdlib/test/io_proto_SUITE.erl index 811c7ed7bb..97e6a90b76 100644 --- a/lib/stdlib/test/io_proto_SUITE.erl +++ b/lib/stdlib/test/io_proto_SUITE.erl @@ -47,7 +47,7 @@ -define(t, test_server). -define(privdir(_), "./io_SUITE_priv"). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(privdir(Conf), ?config(priv_dir, Conf)). -endif. diff --git a/lib/stdlib/test/lists_SUITE.erl b/lib/stdlib/test/lists_SUITE.erl index a0f7fd2744..257607f734 100644 --- a/lib/stdlib/test/lists_SUITE.erl +++ b/lib/stdlib/test/lists_SUITE.erl @@ -22,7 +22,7 @@ %%%----------------------------------------------------------------- -module(lists_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). % Default timetrap timeout (set in init_per_testcase). @@ -1677,8 +1677,7 @@ check_stab(L, U, S, US, SS) -> %%% Element 3 in the tuple is the position of the tuple in the list. biglist(N) -> - {A, B, C} = get_seed(), - random:seed(A, B, C), + rand:seed(exsplus), biglist(N, []). biglist(0, L) -> @@ -1694,8 +1693,7 @@ biglist(N, L) -> %%% No sequence number. ubiglist(N) -> - {A, B, C} = get_seed(), - random:seed(A, B, C), + rand:seed(exsplus), ubiglist(N, []). ubiglist(0, L) -> @@ -1719,8 +1717,7 @@ urandom_tuple(N, I) -> %%% sequence number. bigfunlist(N) -> - {A, B, C} = get_seed(), - random:seed(A, B, C), + rand:seed(exsplus), bigfunlist_1(N). bigfunlist_1(N) when N < 30000 -> % Now (R8) max 32000 different pids. @@ -1754,21 +1751,13 @@ make_fun(Pid) -> fun_pid(Fun) -> erlang:fun_info(Fun, pid). -get_seed() -> - case random:seed() of - undefined -> - erlang:timestamp(); - Tuple -> - Tuple - end. - random_tuple(N, Seq) -> R1 = randint(N), R2 = randint(N), {R1, R2, Seq}. randint(N) -> - trunc(random:uniform() * N). + trunc(rand:uniform() * N). %% The first "duplicate" is kept. no_dups([]) -> @@ -1830,8 +1819,7 @@ sort_loop_1(Pid) -> end. sloop(N) -> - {A, B, C} = get_seed(), - random:seed(A, B, C), + rand:seed(exsplus), sloop(N, #state{}). sloop(N, S) -> diff --git a/lib/stdlib/test/log_mf_h_SUITE.erl b/lib/stdlib/test/log_mf_h_SUITE.erl index 86af3d4614..70d03dd46f 100644 --- a/lib/stdlib/test/log_mf_h_SUITE.erl +++ b/lib/stdlib/test/log_mf_h_SUITE.erl @@ -19,7 +19,7 @@ %% -module(log_mf_h_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/lib/stdlib/test/maps_SUITE.erl b/lib/stdlib/test/maps_SUITE.erl index 40a8b6ac81..f1f476433b 100644 --- a/lib/stdlib/test/maps_SUITE.erl +++ b/lib/stdlib/test/maps_SUITE.erl @@ -23,7 +23,7 @@ -module(maps_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(default_timeout, ?t:minutes(1)). diff --git a/lib/stdlib/test/ms_transform_SUITE.erl b/lib/stdlib/test/ms_transform_SUITE.erl index f02e82b39c..6a9478d0d2 100644 --- a/lib/stdlib/test/ms_transform_SUITE.erl +++ b/lib/stdlib/test/ms_transform_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2011. All Rights Reserved. +%% Copyright Ericsson AB 2003-2015. 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. @@ -20,7 +20,7 @@ -module(ms_transform_SUITE). -author('[email protected]'). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). @@ -342,8 +342,8 @@ records(doc) -> records(Config) when is_list(Config) -> ?line setup(Config), ?line RD = <<"-record(t, {" - "t1 = []," - "t2 = foo," + "t1 = [] :: list()," + "t2 = foo :: atom()," "t3," "t4" "}).">>, diff --git a/lib/stdlib/test/proc_lib_SUITE.erl b/lib/stdlib/test/proc_lib_SUITE.erl index f7a6a38138..a39a82b0df 100644 --- a/lib/stdlib/test/proc_lib_SUITE.erl +++ b/lib/stdlib/test/proc_lib_SUITE.erl @@ -44,7 +44,7 @@ -ifdef(STANDALONE). -define(line, noop, ). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -endif. suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/stdlib/test/qlc_SUITE.erl b/lib/stdlib/test/qlc_SUITE.erl index 52fdb69b73..6f94e740eb 100644 --- a/lib/stdlib/test/qlc_SUITE.erl +++ b/lib/stdlib/test/qlc_SUITE.erl @@ -43,7 +43,7 @@ -define(testcase, current_testcase). % don't know -define(t, test_server). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(datadir, ?config(data_dir, Config)). -define(privdir, ?config(priv_dir, Config)). -define(testcase, ?config(?TESTCASE, Config)). diff --git a/lib/stdlib/test/queue_SUITE.erl b/lib/stdlib/test/queue_SUITE.erl index c965a8b218..77fe6adb7c 100644 --- a/lib/stdlib/test/queue_SUITE.erl +++ b/lib/stdlib/test/queue_SUITE.erl @@ -25,7 +25,7 @@ -export([init_per_testcase/2, end_per_testcase/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). % Default timetrap timeout (set in init_per_testcase). -define(default_timeout, ?t:minutes(1)). @@ -470,7 +470,7 @@ oops(suite) -> oops(Config) when is_list(Config) -> ?line N = 3142, ?line Optab = optab(), - ?line Seed0 = random:seed0(), + ?line Seed0 = rand:seed(exsplus, {1,2,4}), ?line {Is,Seed} = random_list(N, tuple_size(Optab), Seed0, []), ?line io:format("~p ", [Is]), ?line QA = queue:new(), @@ -562,20 +562,20 @@ args([], _, Seed, R) -> args([q|Ts], [Q|Qs]=Qss, Seed, R) -> args(Ts, if Qs =:= [] -> Qss; true -> Qs end, Seed, [Q|R]); args([l|Ts], Qs, Seed0, R) -> - {N,Seed1} = random:uniform_s(17, Seed0), + {N,Seed1} = rand:uniform_s(17, Seed0), {L,Seed} = random_list(N, 4711, Seed1, []), args(Ts, Qs, Seed, [L|R]); args([t|Ts], Qs, Seed0, R) -> - {T,Seed} = random:uniform_s(4711, Seed0), + {T,Seed} = rand:uniform_s(4711, Seed0), args(Ts, Qs, Seed, [T|R]); args([n|Ts], Qs, Seed0, R) -> - {N,Seed} = random:uniform_s(17, Seed0), + {N,Seed} = rand:uniform_s(17, Seed0), args(Ts, Qs, Seed, [N|R]). random_list(0, _, Seed, R) -> {R,Seed}; random_list(N, M, Seed0, R) -> - {X,Seed} = random:uniform_s(M, Seed0), + {X,Seed} = rand:uniform_s(M, Seed0), random_list(N-1, M, Seed, [X|R]). call(Func, As) -> diff --git a/lib/stdlib/test/rand_SUITE.erl b/lib/stdlib/test/rand_SUITE.erl index 03b5ce1a25..ab260da950 100644 --- a/lib/stdlib/test/rand_SUITE.erl +++ b/lib/stdlib/test/rand_SUITE.erl @@ -33,7 +33,7 @@ -export([test/0, gen/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). % Default timetrap timeout (set in init_per_testcase). -define(default_timeout, ?t:minutes(3)). diff --git a/lib/stdlib/test/random_SUITE.erl b/lib/stdlib/test/random_SUITE.erl index 738f73ae15..701a3e3f33 100644 --- a/lib/stdlib/test/random_SUITE.erl +++ b/lib/stdlib/test/random_SUITE.erl @@ -25,7 +25,7 @@ -export([init_per_testcase/2, end_per_testcase/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). % Default timetrap timeout (set in init_per_testcase). -define(default_timeout, ?t:minutes(1)). diff --git a/lib/stdlib/test/random_iolist.erl b/lib/stdlib/test/random_iolist.erl index 9a0f034e72..6da7da04de 100644 --- a/lib/stdlib/test/random_iolist.erl +++ b/lib/stdlib/test/random_iolist.erl @@ -36,7 +36,7 @@ run2(Iter,Fun1,Fun2) -> compare2(Iter,Fun1,Fun2). random_byte() -> - random:uniform(256) - 1. + rand:uniform(256) - 1. random_list(0,Acc) -> Acc; @@ -45,7 +45,7 @@ random_list(N,Acc) -> random_binary(N) -> B = list_to_binary(random_list(N,[])), - case {random:uniform(2),size(B)} of + case {rand:uniform(2),size(B)} of {2,M} when M > 1 -> S = M-1, <<_:3,C:S/binary,_:5>> = B, @@ -57,7 +57,7 @@ random_list(N) -> random_list(N,[]). front() -> - case random:uniform(10) of + case rand:uniform(10) of 10 -> false; _ -> @@ -65,7 +65,7 @@ front() -> end. any_type() -> - case random:uniform(10) of + case rand:uniform(10) of 1 -> list; 2 -> @@ -77,7 +77,7 @@ any_type() -> end. tail_type() -> - case random:uniform(5) of + case rand:uniform(5) of 1 -> list; 2 -> @@ -90,9 +90,9 @@ random_length(N) -> UpperLimit = 255, case N of M when M > UpperLimit -> - random:uniform(UpperLimit+1) - 1; + rand:uniform(UpperLimit+1) - 1; _ -> - random:uniform(N+1) - 1 + rand:uniform(N+1) - 1 end. random_iolist(0,Acc) -> @@ -139,7 +139,7 @@ random_iolist(N) -> standard_seed() -> - random:seed(1201,855653,380975). + rand:seed(exsplus, {1201,855653,380975}). do_comp(List,F1,F2) -> X = F1(List), diff --git a/lib/stdlib/test/random_unicode_list.erl b/lib/stdlib/test/random_unicode_list.erl index ecafe42318..3bc86a8430 100644 --- a/lib/stdlib/test/random_unicode_list.erl +++ b/lib/stdlib/test/random_unicode_list.erl @@ -85,7 +85,7 @@ int_to_utf32_little(I) -> id(I) -> I. random_char() -> - case random:uniform(16#10FFFF+1) - 1 of + case rand:uniform(16#10FFFF+1) - 1 of X when X >= 16#D800, X =< 16#DFFF -> random_char(); @@ -116,13 +116,13 @@ random_binary(N,Enc) -> int_to(Enc,X) end, L)), - case {random:uniform(3),size(B)} of + case {rand:uniform(3),size(B)} of {2,M} when M > 1 -> B2 = id(<<1:3,B/binary,1:5>>), <<_:3,C:M/binary,_:5>> = B2, C; {3,M} when M > 1 -> - X = random:uniform(M+1)-1, + X = rand:uniform(M+1)-1, <<B1:X/binary,B2/binary>> = B, [B1,B2]; _ -> @@ -132,7 +132,7 @@ random_list(N) -> random_list(N,[]). front() -> - case random:uniform(10) of + case rand:uniform(10) of 10 -> false; _ -> @@ -140,7 +140,7 @@ front() -> end. any_type() -> - case random:uniform(10) of + case rand:uniform(10) of 1 -> list; 2 -> @@ -152,7 +152,7 @@ any_type() -> end. tail_type() -> - case random:uniform(5) of + case rand:uniform(5) of 1 -> list; 2 -> @@ -165,9 +165,9 @@ random_length(N) -> UpperLimit = 255, case N of M when M > UpperLimit -> - random:uniform(UpperLimit+1) - 1; + rand:uniform(UpperLimit+1) - 1; _ -> - random:uniform(N+1) - 1 + rand:uniform(N+1) - 1 end. random_unicode_list(0,Acc,_Enc) -> @@ -214,7 +214,7 @@ random_unicode_list(N,Enc) -> standard_seed() -> - random:seed(1201,855653,380975). + rand:seed(exsplus, {1201,855653,380975}). do_comp(List,F1,F2) -> X = F1(List), diff --git a/lib/stdlib/test/re_SUITE.erl b/lib/stdlib/test/re_SUITE.erl index d78d6153da..bd495ce587 100644 --- a/lib/stdlib/test/re_SUITE.erl +++ b/lib/stdlib/test/re_SUITE.erl @@ -30,7 +30,7 @@ opt_no_start_optimize/1,opt_never_utf/1,opt_ucp/1, match_limit/1,sub_binaries/1,copt/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/stdlib/test/run_pcre_tests.erl b/lib/stdlib/test/run_pcre_tests.erl index 1fdc777470..b7d1df39b8 100644 --- a/lib/stdlib/test/run_pcre_tests.erl +++ b/lib/stdlib/test/run_pcre_tests.erl @@ -1083,7 +1083,7 @@ dumponesplit(F,{RE,Line,O,TS}) -> %% Generate replacement tests from indatafile, %% you will need perl on the machine gen_repl_test(OneFile) -> - random:seed(1219,687731,62804), + rand:seed(exsplus, {1219,687731,62804}), {ok,Bin} = file:read_file(OneFile), Lines = splitfile(0,Bin,1), Structured = stru(Lines), @@ -1237,15 +1237,15 @@ btr(_) -> ranchar() -> - case random:uniform(10) of + case rand:uniform(10) of 9 -> $&; 10 -> <<"\\1">>; N when N < 5 -> - random:uniform($Z-$A)+$A-1; + rand:uniform($Z-$A)+$A-1; M when M < 9 -> - random:uniform($z-$a)+$a-1 + rand:uniform($z-$a)+$a-1 end. ranstring() -> - iolist_to_binary([ranchar() || _ <- lists:duplicate(random:uniform(20),0) ]). + iolist_to_binary([ranchar() || _ <- lists:duplicate(rand:uniform(20),0) ]). diff --git a/lib/stdlib/test/select_SUITE.erl b/lib/stdlib/test/select_SUITE.erl index ead64ffc75..f92971583a 100644 --- a/lib/stdlib/test/select_SUITE.erl +++ b/lib/stdlib/test/select_SUITE.erl @@ -38,7 +38,7 @@ -export([config/2]). -define(fmt(A,B),io:format(A,B)). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(fmt(A,B),test_server:format(A,B)). -endif. @@ -212,11 +212,10 @@ init_random(Config) -> {ok,[X]} -> X; _ -> - {A,B,C} = erlang:timestamp(), - random:seed(A,B,C), - get(random_seed) + rand:seed(exsplus), + rand:export_seed() end, - put(random_seed,Seed), + rand:seed(Seed), {ok, F} = file:open(filename:join([WriteDir, "last_random_seed2.txt"]), [write]), io:format(F,"~p. ~n",[Seed]), @@ -224,11 +223,11 @@ init_random(Config) -> ok. create_random_key(N,Type) -> - gen_key(random:uniform(N),Type). + gen_key(rand:uniform(N),Type). create_pb_key(N,list) -> - X = random:uniform(N), - case random:uniform(4) of + X = rand:uniform(N), + case rand:uniform(4) of 3 -> {[X, X+1, '_'], fun([Z,Z1,P1]) -> [Z,Z1,P1] =:= [X,X+1,P1] end}; 2 -> {[X, '_', '_'], fun([Z,P1,P2]) -> [Z,P1,P2] =:= [X,P1,P2] end}; @@ -237,14 +236,14 @@ create_pb_key(N,list) -> _ -> {[X, '$1', '$2'], fun([Z,P1,P2]) -> [Z,P1,P2] =:= [X,P1,P2] end} end; create_pb_key(N, tuple) -> - X = random:uniform(N), - case random:uniform(2) of + X = rand:uniform(N), + case rand:uniform(2) of 1 -> {{X, X+1, '$1'},fun({Z,Z1,P1}) -> {Z,Z1,P1} =:= {X,X+1,P1} end}; _ -> {{X, '$1', '$2'},fun({Z,P1,P2}) -> {Z,P1,P2} =:= {X,P1,P2} end} end; create_pb_key(N, complex) -> - X = random:uniform(N), - case random:uniform(2) of + X = rand:uniform(N), + case rand:uniform(2) of 1 -> {{[X, X+1], '$1'}, fun({[Z,Z1],P1}) -> {[Z,Z1],P1} =:= {[X,X+1],P1} end}; _ -> {{[X, '$1'], '$2'},fun({[Z,P1],P2}) -> diff --git a/lib/stdlib/test/sets_SUITE.erl b/lib/stdlib/test/sets_SUITE.erl index 972a812072..06da696700 100644 --- a/lib/stdlib/test/sets_SUITE.erl +++ b/lib/stdlib/test/sets_SUITE.erl @@ -31,7 +31,7 @@ is_set/1,fold/1,filter/1, take_smallest/1,take_largest/1, iterate/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -import(lists, [foldl/3,reverse/1]). @@ -107,9 +107,9 @@ add_element_del([H|T], M, S, Del, []) -> add_element_del(T, M, M(add_element, {H,S}), Del, [H]); add_element_del([H|T], M, S0, Del, Inserted) -> S1 = M(add_element, {H,S0}), - case random:uniform(3) of + case rand:uniform(3) of 1 -> - OldEl = lists:nth(random:uniform(length(Inserted)), Inserted), + OldEl = lists:nth(rand:uniform(length(Inserted)), Inserted), S = M(del_element, {OldEl,S1}), add_element_del(T, M, S, [OldEl|Del], [H|Inserted]); _ -> @@ -438,7 +438,7 @@ iterate_1(M) -> M(empty, []). iterate_2(M) -> - random:seed(1, 2, 42), + rand:seed(exsplus, {1,2,42}), iter_set(M, 1000). iter_set(_M, 0) -> @@ -447,7 +447,7 @@ iter_set(M, N) -> L = [I || I <- lists:seq(1, N)], T = M(from_list, L), L = lists:reverse(iterate_set(M, T)), - R = random:uniform(N), + R = rand:uniform(N), S = lists:reverse(iterate_set(M, R, T)), S = [E || E <- L, E >= R], iter_set(M, N-1). @@ -481,7 +481,7 @@ sets_mods() -> test_all(Tester) -> Res = [begin - random:seed(1, 2, 42), + rand:seed(exsplus, {1,2,42}), S = Tester(M), {M(size, S),lists:sort(M(to_list, S))} end || M <- sets_mods()], @@ -492,7 +492,7 @@ test_all([{Low,High}|T], Tester) -> test_all([Sz|T], Tester) when is_integer(Sz) -> List = rnd_list(Sz), Res = [begin - random:seed(19, 2, Sz), + rand:seed(exsplus, {19,2,Sz}), S = Tester(List, M), {M(size, S),lists:sort(M(to_list, S))} end || M <- sets_mods()], @@ -512,10 +512,10 @@ rnd_list(Sz) -> rnd_list_1(Sz, []). atomic_rnd_term() -> - case random:uniform(3) of - 1 -> list_to_atom(integer_to_list($\s+random:uniform(94))++"rnd"); - 2 -> random:uniform(); - 3 -> random:uniform(50)-37 + case rand:uniform(3) of + 1 -> list_to_atom(integer_to_list($\s+rand:uniform(94))++"rnd"); + 2 -> rand:uniform(); + 3 -> rand:uniform(50)-37 end. rnd_list_1(0, Acc) -> Acc; @@ -543,7 +543,7 @@ remove_some(List0, P) -> end. remove_some([H|T], P, Acc) -> - case random:uniform() of + case rand:uniform() of F when F < P -> %Remove. remove_some(T, P, Acc); _ -> diff --git a/lib/stdlib/test/shell_SUITE.erl b/lib/stdlib/test/shell_SUITE.erl index a9dd6b5817..747b76abb6 100644 --- a/lib/stdlib/test/shell_SUITE.erl +++ b/lib/stdlib/test/shell_SUITE.erl @@ -52,7 +52,7 @@ config(priv_dir,_) -> ".". -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([init_per_testcase/2, end_per_testcase/2]). % Default timetrap timeout (set in init_per_testcase). -define(default_timeout, ?t:minutes(10)). @@ -393,7 +393,9 @@ records(Config) when is_list(Config) -> Test = filename:join(?config(priv_dir, Config), "test.erl"), Contents = <<"-module(test). - -record(state, {bin, reply, leader}). + -record(state, {bin :: binary(), + reply = no, + leader = some :: atom()}). -ifdef(test1). -record(test1, {f}). diff --git a/lib/stdlib/test/slave_SUITE.erl b/lib/stdlib/test/slave_SUITE.erl index 65627b3741..f01bf77550 100644 --- a/lib/stdlib/test/slave_SUITE.erl +++ b/lib/stdlib/test/slave_SUITE.erl @@ -19,7 +19,7 @@ %% -module(slave_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, t_start/1, t_start_link/1, diff --git a/lib/stdlib/test/sofs_SUITE.erl b/lib/stdlib/test/sofs_SUITE.erl index d23eb3abb9..9eed2893d4 100644 --- a/lib/stdlib/test/sofs_SUITE.erl +++ b/lib/stdlib/test/sofs_SUITE.erl @@ -27,7 +27,7 @@ -define(config(X,Y), foo). -define(t, test_server). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(format(S, A), ok). -endif. diff --git a/lib/stdlib/test/stdlib_SUITE.erl b/lib/stdlib/test/stdlib_SUITE.erl index a586729b30..687e2fb6e8 100644 --- a/lib/stdlib/test/stdlib_SUITE.erl +++ b/lib/stdlib/test/stdlib_SUITE.erl @@ -21,7 +21,7 @@ %%% Purpose:Stdlib application test suite. %%%----------------------------------------------------------------- -module(stdlib_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -compile(export_all). diff --git a/lib/stdlib/test/string_SUITE.erl b/lib/stdlib/test/string_SUITE.erl index 53eea6f180..6ac3950f44 100644 --- a/lib/stdlib/test/string_SUITE.erl +++ b/lib/stdlib/test/string_SUITE.erl @@ -21,7 +21,7 @@ %%% Purpose: string test suite. %%%----------------------------------------------------------------- -module(string_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). % Default timetrap timeout (set in init_per_testcase). diff --git a/lib/stdlib/test/supervisor_SUITE.erl b/lib/stdlib/test/supervisor_SUITE.erl index 8cb2a5194a..903ca76575 100644 --- a/lib/stdlib/test/supervisor_SUITE.erl +++ b/lib/stdlib/test/supervisor_SUITE.erl @@ -67,6 +67,7 @@ %% Misc tests -export([child_unlink/1, tree/1, count_children/1, + count_restarting_children/1, do_not_save_start_parameters_for_temporary_children/1, do_not_save_child_specs_for_temporary_children/1, simple_one_for_one_scale_many_temporary_children/1, @@ -90,7 +91,8 @@ all() -> {group, normal_termination}, {group, shutdown_termination}, {group, abnormal_termination}, child_unlink, tree, - count_children, do_not_save_start_parameters_for_temporary_children, + count_children, count_restarting_children, + do_not_save_start_parameters_for_temporary_children, do_not_save_child_specs_for_temporary_children, simple_one_for_one_scale_many_temporary_children, temporary_bystander, simple_global_supervisor, hanging_restart_loop, hanging_restart_loop_simple, @@ -1459,6 +1461,54 @@ count_children(Config) when is_list(Config) -> [1,0,0,0] = get_child_counts(sup_test). %%------------------------------------------------------------------------- +%% Test count_children when some children are restarting +count_restarting_children(Config) when is_list(Config) -> + process_flag(trap_exit, true), + Child = {child, {supervisor_deadlock, start_child_noreg, []}, + permanent, brutal_kill, worker, []}, + %% 2 sek delay on failing restart (see supervisor_deadlock.erl) -> + %% MaxR=20, MaxT=10 should ensure a restart loop when starting and + %% restarting 3 instances of the child (as below) + {ok, SupPid} = start_link({ok, {{simple_one_for_one, 20, 10}, [Child]}}), + + %% Ets table with state read by supervisor_deadlock.erl + ets:new(supervisor_deadlock,[set,named_table,public]), + ets:insert(supervisor_deadlock,{fail_start,false}), + + [1,0,0,0] = get_child_counts(SupPid), + {ok, Ch1_1} = supervisor:start_child(SupPid, []), + [1,1,0,1] = get_child_counts(SupPid), + {ok, Ch1_2} = supervisor:start_child(SupPid, []), + [1,2,0,2] = get_child_counts(SupPid), + {ok, Ch1_3} = supervisor:start_child(SupPid, []), + [1,3,0,3] = get_child_counts(SupPid), + + supervisor_deadlock:restart_child(Ch1_1), + supervisor_deadlock:restart_child(Ch1_2), + supervisor_deadlock:restart_child(Ch1_3), + test_server:sleep(400), + [1,3,0,3] = get_child_counts(SupPid), + [Ch2_1, Ch2_2, Ch2_3] = [C || {_,C,_,_} <- supervisor:which_children(SupPid)], + + ets:insert(supervisor_deadlock,{fail_start,true}), + supervisor_deadlock:restart_child(Ch2_1), + supervisor_deadlock:restart_child(Ch2_2), + test_server:sleep(4000), % allow restart to happen before proceeding + [1,1,0,3] = get_child_counts(SupPid), + + ets:insert(supervisor_deadlock,{fail_start,false}), + test_server:sleep(4000), % allow restart to happen before proceeding + [1,3,0,3] = get_child_counts(SupPid), + + ok = supervisor:terminate_child(SupPid, Ch2_3), + [1,2,0,2] = get_child_counts(SupPid), + [Ch3_1, Ch3_2] = [C || {_,C,_,_} <- supervisor:which_children(SupPid)], + ok = supervisor:terminate_child(SupPid, Ch3_1), + [1,1,0,1] = get_child_counts(SupPid), + ok = supervisor:terminate_child(SupPid, Ch3_2), + [1,0,0,0] = get_child_counts(SupPid). + +%%------------------------------------------------------------------------- %% Temporary children shall not be restarted so they should not save %% start parameters, as it potentially can take up a huge amount of %% memory for no purpose. diff --git a/lib/stdlib/test/supervisor_bridge_SUITE.erl b/lib/stdlib/test/supervisor_bridge_SUITE.erl index b55fbfaf0d..94e719bea1 100644 --- a/lib/stdlib/test/supervisor_bridge_SUITE.erl +++ b/lib/stdlib/test/supervisor_bridge_SUITE.erl @@ -24,7 +24,7 @@ simple_global_supervisor/1]). -export([client/1,init/1,internal_loop_init/1,terminate/2,server9212/0]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(bridge_name,supervisor_bridge_SUITE_server). -define(work_bridge_name,work_supervisor_bridge_SUITE_server). diff --git a/lib/stdlib/test/supervisor_deadlock.erl b/lib/stdlib/test/supervisor_deadlock.erl index 288547a972..8d3d1c6f30 100644 --- a/lib/stdlib/test/supervisor_deadlock.erl +++ b/lib/stdlib/test/supervisor_deadlock.erl @@ -11,9 +11,11 @@ init([child]) -> %% terminates immediately {ok, []}; [{fail_start, true}] -> - %% Restart frequency is MaxR=8, MaxT=10, so this will - %% ensure that restart intensity is not reached -> restart - %% loop + %% A restart frequency of MaxR=8, MaxT=10 should ensure + %% that restart intensity is not reached -> restart loop. + %% (Note that if we use simple_one_for_one, and start + %% 'many' child instances, the restart frequency must be + %% ajusted accordingly.) timer:sleep(2000), % NOTE: this could be a gen_server call timeout {stop, error} @@ -41,5 +43,11 @@ code_change(_OldVsn, State, _Extra) -> start_child() -> gen_server:start_link({local, ?MODULE}, ?MODULE, [child], []). +start_child_noreg() -> + gen_server:start_link(?MODULE, [child], []). + restart_child() -> gen_server:cast(supervisor_deadlock, restart). + +restart_child(Pid) -> + gen_server:cast(Pid, restart). diff --git a/lib/stdlib/test/sys_SUITE.erl b/lib/stdlib/test/sys_SUITE.erl index 573fa6f358..102a147fcd 100644 --- a/lib/stdlib/test/sys_SUITE.erl +++ b/lib/stdlib/test/sys_SUITE.erl @@ -22,7 +22,7 @@ init_per_group/2,end_per_group/2,log/1,log_to_file/1, stats/1,trace/1,suspend/1,install/1,special_process/1]). -export([handle_call/3,terminate/2,init/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(server,sys_SUITE_server). diff --git a/lib/stdlib/test/tar_SUITE.erl b/lib/stdlib/test/tar_SUITE.erl index 6da017f818..a22eaa1d3a 100644 --- a/lib/stdlib/test/tar_SUITE.erl +++ b/lib/stdlib/test/tar_SUITE.erl @@ -26,7 +26,7 @@ extract_from_open_file/1, symlinks/1, open_add_close/1, cooked_compressed/1, memory/1,unicode/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/stdlib/test/timer_SUITE.erl b/lib/stdlib/test/timer_SUITE.erl index 057d82fb65..e4d656c9bf 100644 --- a/lib/stdlib/test/timer_SUITE.erl +++ b/lib/stdlib/test/timer_SUITE.erl @@ -24,7 +24,7 @@ -export([big_test/1, collect/3, i_t/3, a_t/2]). -export([do_nrev/1, internal_watchdog/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Random test of the timer module. This is a really nasty test, as it %% runs a lot of timeouts and then checks in the end if any of them @@ -80,8 +80,6 @@ report_result(Error) -> ?line test_server:fail(Error). big_test(N) -> C = start_collect(), system_time(), system_time(), system_time(), - random:seed(erlang:timestamp()), - random:uniform(100),random:uniform(100),random:uniform(100), big_loop(C, N, []), @@ -127,17 +125,17 @@ big_loop(C, N, Pids) -> after 0 -> %% maybe start an interval timer test - Pids1 = maybe_start_i_test(Pids, C, random:uniform(4)), + Pids1 = maybe_start_i_test(Pids, C, rand:uniform(4)), %% start 1-4 "after" tests - Pids2 = start_after_test(Pids1, C, random:uniform(4)), + Pids2 = start_after_test(Pids1, C, rand:uniform(4)), %%Pids2=Pids1, %% wait a little while - timer:sleep(random:uniform(200)*3), + timer:sleep(rand:uniform(200)*3), %% spawn zero, one or two nrev to get some load ;-/ - Pids3 = start_nrev(Pids2, random:uniform(100)), + Pids3 = start_nrev(Pids2, rand:uniform(100)), big_loop(C, N-1, Pids3) end. @@ -148,20 +146,20 @@ start_nrev(Pids, N) when N < 25 -> start_nrev(Pids, N) when N < 75 -> [spawn_link(timer_SUITE, do_nrev, [1])|Pids]; start_nrev(Pids, _N) -> - NrevPid1 = spawn_link(timer_SUITE, do_nrev, [random:uniform(1000)*10]), + NrevPid1 = spawn_link(timer_SUITE, do_nrev, [rand:uniform(1000)*10]), NrevPid2 = spawn_link(timer_SUITE, do_nrev, [1]), [NrevPid1,NrevPid2|Pids]. start_after_test(Pids, C, 1) -> - TO1 = random:uniform(100)*47, + TO1 = rand:uniform(100)*47, [s_a_t(C, TO1)|Pids]; start_after_test(Pids, C, 2) -> - TO1 = random:uniform(100)*47, - TO2 = TO1 div random:uniform(3) + 101, + TO1 = rand:uniform(100)*47, + TO2 = TO1 div rand:uniform(3) + 101, [s_a_t(C, TO1),s_a_t(C, TO2)|Pids]; start_after_test(Pids, C, N) -> - TO1 = random:uniform(100)*47, + TO1 = rand:uniform(100)*47, start_after_test([s_a_t(C, TO1)|Pids], C, N-1). s_a_t(C, TimeOut) -> @@ -187,8 +185,8 @@ a_t(C, TimeOut) -> maybe_start_i_test(Pids, C, 1) -> %% ok do it - TOI = random:uniform(53)*49, - CountI = random:uniform(10) + 3, % at least 4 times + TOI = rand:uniform(53)*49, + CountI = rand:uniform(10) + 3, % at least 4 times [spawn_link(timer_SUITE, i_t, [C, TOI, CountI])|Pids]; maybe_start_i_test(Pids, _C, _) -> Pids. diff --git a/lib/stdlib/test/timer_simple_SUITE.erl b/lib/stdlib/test/timer_simple_SUITE.erl index 93fbc3a032..42b96c4b1c 100644 --- a/lib/stdlib/test/timer_simple_SUITE.erl +++ b/lib/stdlib/test/timer_simple_SUITE.erl @@ -51,7 +51,7 @@ timer/4, timer/5]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(MAXREF, (1 bsl 18)). -define(REFMARG, 30). diff --git a/lib/stdlib/test/unicode_SUITE.erl b/lib/stdlib/test/unicode_SUITE.erl index 8bb2555213..f45e00928e 100644 --- a/lib/stdlib/test/unicode_SUITE.erl +++ b/lib/stdlib/test/unicode_SUITE.erl @@ -19,7 +19,7 @@ %% -module(unicode_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, diff --git a/lib/stdlib/test/win32reg_SUITE.erl b/lib/stdlib/test/win32reg_SUITE.erl index 82baa43318..982cc86979 100644 --- a/lib/stdlib/test/win32reg_SUITE.erl +++ b/lib/stdlib/test/win32reg_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,long/1,evil_write/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/stdlib/test/y2k_SUITE.erl b/lib/stdlib/test/y2k_SUITE.erl index 9e766e80ab..d80dd10631 100644 --- a/lib/stdlib/test/y2k_SUITE.erl +++ b/lib/stdlib/test/y2k_SUITE.erl @@ -22,7 +22,7 @@ -module(y2k_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, diff --git a/lib/stdlib/test/zip_SUITE.erl b/lib/stdlib/test/zip_SUITE.erl index c275053691..135bfd5867 100644 --- a/lib/stdlib/test/zip_SUITE.erl +++ b/lib/stdlib/test/zip_SUITE.erl @@ -28,8 +28,7 @@ compress_control/1, foldl/1]). --include_lib("test_server/include/test_server.hrl"). --include("test_server_line.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). -include_lib("stdlib/include/zip.hrl"). diff --git a/lib/syntax_tools/src/erl_recomment.erl b/lib/syntax_tools/src/erl_recomment.erl index 72e1e2d2f5..5ce533285d 100644 --- a/lib/syntax_tools/src/erl_recomment.erl +++ b/lib/syntax_tools/src/erl_recomment.erl @@ -611,12 +611,15 @@ expand_comment(C) -> attrs :: erl_syntax:syntaxTreeAttributes(), precomments = [] :: [erl_syntax:syntaxTree()], postcomments = [] :: [erl_syntax:syntaxTree()], - subtrees = [] :: [erl_syntax:syntaxTree()]}). + subtrees = [] :: [extendedSyntaxTree()]}). + -record(list, {min = 0 :: integer(), max = 0 :: integer(), subtrees = [] :: [erl_syntax:syntaxTree()]}). +-type extendedSyntaxTree() :: #tree{} | #leaf{} | #list{}. + leaf_node(Min, Max, Value) -> #leaf{min = Min, max = Max, diff --git a/lib/syntax_tools/src/erl_syntax.erl b/lib/syntax_tools/src/erl_syntax.erl index 3f2a3e05dd..97b5797b06 100644 --- a/lib/syntax_tools/src/erl_syntax.erl +++ b/lib/syntax_tools/src/erl_syntax.erl @@ -355,7 +355,7 @@ %% where `Pos' `Ann' and `Comments' are the corresponding values of a %% `tree' or `wrapper' record. --record(attr, {pos = 0 :: term(), +-record(attr, {pos = erl_anno:new(0) :: term(), ann = [] :: [term()], com = none :: 'none' | #com{}}). -type syntaxTreeAttributes() :: #attr{}. diff --git a/lib/syntax_tools/src/erl_syntax_lib.erl b/lib/syntax_tools/src/erl_syntax_lib.erl index 5b5b18d15b..58c4cc5244 100644 --- a/lib/syntax_tools/src/erl_syntax_lib.erl +++ b/lib/syntax_tools/src/erl_syntax_lib.erl @@ -359,9 +359,9 @@ new_variable_name(S) -> %% within a reasonably small range relative to the number of elements in %% the set. %% -%% This function uses the module `random' to generate new +%% This function uses the module `rand' to generate new %% keys. The seed it uses may be initialized by calling -%% `random:seed/0' or `random:seed/3' before this +%% `rand:seed/1' or `rand:seed/2' before this %% function is first called. %% %% @see new_variable_name/1 @@ -404,7 +404,13 @@ start_range(S) -> %% order, but (pseudo-)randomly distributed over the range. generate(_Key, Range) -> - random:uniform(Range). % works well + _ = case rand:export_seed() of + undefined -> + rand:seed(exsplus, {753,8,73}); + _ -> + ok + end, + rand:uniform(Range). % works well %% ===================================================================== diff --git a/lib/syntax_tools/src/erl_tidy.erl b/lib/syntax_tools/src/erl_tidy.erl index db7f0939a3..f2de12b410 100644 --- a/lib/syntax_tools/src/erl_tidy.erl +++ b/lib/syntax_tools/src/erl_tidy.erl @@ -937,7 +937,7 @@ hidden_uses_2(Tree, Used) -> -record(env, {file :: file:filename(), module :: atom(), - current :: fa(), + current :: fa() | 'undefined', imports = dict:new() :: dict:dict(atom(), atom()), context = normal :: context(), verbosity = 1 :: 0 | 1 | 2, @@ -949,10 +949,10 @@ hidden_uses_2(Tree, Used) -> new_guard_tests = true :: boolean(), old_guard_tests = false :: boolean()}). --record(st, {varc :: non_neg_integer(), +-record(st, {varc :: non_neg_integer() | 'undefined', used = sets:new() :: sets:set({atom(), arity()}), imported :: sets:set({atom(), arity()}), - vars :: sets:set(atom()), + vars :: sets:set(atom()) | 'undefined', functions :: sets:set({atom(), arity()}), new_forms = [] :: [erl_syntax:syntaxTree()], rename :: dict:dict(mfa(), {atom(), atom()})}). @@ -1064,13 +1064,13 @@ visit_clause(Tree, Env, St0) -> visit_infix_expr(Tree, #env{context = guard_test}, St0) -> %% Detect transition from guard test to guard expression. - visit_other(Tree, #env{context = guard_expr}, St0); + visit_other(Tree, #env{context = guard_expr, file = ""}, St0); visit_infix_expr(Tree, Env, St0) -> visit_other(Tree, Env, St0). visit_prefix_expr(Tree, #env{context = guard_test}, St0) -> %% Detect transition from guard test to guard expression. - visit_other(Tree, #env{context = guard_expr}, St0); + visit_other(Tree, #env{context = guard_expr, file = ""}, St0); visit_prefix_expr(Tree, Env, St0) -> visit_other(Tree, Env, St0). diff --git a/lib/syntax_tools/src/igor.erl b/lib/syntax_tools/src/igor.erl index eac5af5540..4557678f9d 100644 --- a/lib/syntax_tools/src/igor.erl +++ b/lib/syntax_tools/src/igor.erl @@ -1594,10 +1594,11 @@ alias_expansions_2(Modules, Table) -> preserved :: boolean(), no_headers :: boolean(), notes :: notes(), - map :: map_fun(), + map :: map_fun() | 'undefined', renaming :: fun((atom()) -> map_fun()), expand :: dict:dict({atom(), integer()}, - {atom(), {atom(), integer()}}), + {atom(), {atom(), integer()}}) + | 'undefined', redirect :: dict:dict(atom(), atom()) }). diff --git a/lib/syntax_tools/src/merl.erl b/lib/syntax_tools/src/merl.erl index 690306c17b..163ce48bbc 100644 --- a/lib/syntax_tools/src/merl.erl +++ b/lib/syntax_tools/src/merl.erl @@ -514,15 +514,17 @@ parse_forms([]) -> parse_2(Ts) -> %% one or more comma-separated expressions? %% (recall that Ts has no dot tokens if we get to this stage) - case erl_parse:parse_exprs(Ts ++ [{dot,0}]) of + A = a0(), + case erl_parse:parse_exprs(Ts ++ [{dot,A}]) of {ok, Exprs} -> Exprs; {error, E} -> - parse_3(Ts ++ [{'end',0}, {dot,0}], [E]) + parse_3(Ts ++ [{'end',A}, {dot,A}], [E]) end. parse_3(Ts, Es) -> %% try-clause or clauses? - case erl_parse:parse_exprs([{'try',0}, {atom,0,true}, {'catch',0} | Ts]) of + A = a0(), + case erl_parse:parse_exprs([{'try',A}, {atom,A,true}, {'catch',A} | Ts]) of {ok, [{'try',_,_,_,_,_}=X]} -> %% get the right kind of qualifiers in the clause patterns erl_syntax:try_expr_handlers(X); @@ -533,7 +535,8 @@ parse_3(Ts, Es) -> parse_4(Ts, Es) -> %% fun-clause or clauses? (`(a)' is also a pattern, but `(a,b)' isn't, %% so fun-clauses must be tried before normal case-clauses - case erl_parse:parse_exprs([{'fun',0} | Ts]) of + A = a0(), + case erl_parse:parse_exprs([{'fun',A} | Ts]) of {ok, [{'fun',_,{clauses,Cs}}]} -> Cs; {error, E} -> parse_5(Ts, [E|Es]) @@ -541,7 +544,8 @@ parse_4(Ts, Es) -> parse_5(Ts, Es) -> %% case-clause or clauses? - case erl_parse:parse_exprs([{'case',0}, {atom,0,true}, {'of',0} | Ts]) of + A = a0(), + case erl_parse:parse_exprs([{'case',A}, {atom,A,true}, {'of',A} | Ts]) of {ok, [{'case',_,_,Cs}]} -> Cs; {error, E} -> %% select the best error to report @@ -1210,7 +1214,7 @@ merge_comments(StartLine, Cs, [], Acc) -> merge_comments(StartLine, [], [], [erl_syntax:set_pos( erl_syntax:comment(Indent, Text), - StartLine + Line - 1) + anno(StartLine + Line - 1)) || {Line, _, Indent, Text} <- Cs] ++ Acc); merge_comments(StartLine, [C|Cs], [T|Ts], Acc) -> {Line, _Col, Indent, Text} = C, @@ -1228,3 +1232,9 @@ merge_comments(StartLine, [C|Cs], [T|Ts], Acc) -> [erl_syntax:comment(Indent, Text)], T), merge_comments(StartLine, Cs, [Tc|Ts], Acc) end. + +a0() -> + anno(0). + +anno(Location) -> + erl_anno:new(Location). diff --git a/lib/syntax_tools/src/merl_transform.erl b/lib/syntax_tools/src/merl_transform.erl index 66b06c8137..fe58b6a122 100644 --- a/lib/syntax_tools/src/merl_transform.erl +++ b/lib/syntax_tools/src/merl_transform.erl @@ -68,8 +68,7 @@ case_guard([{expr,_}, {text,Text}]) -> erl_syntax:is_literal(Text). case_body([{expr,Expr}, {text,_Text}], T) -> - pre_expand_case(Expr, erl_syntax:case_expr_clauses(T), - erl_syntax:get_pos(T)). + pre_expand_case(Expr, erl_syntax:case_expr_clauses(T), get_location(T)). post(T) -> merl:switch( @@ -79,7 +78,7 @@ post(T) -> lists:all(fun erl_syntax:is_literal/1, [F|As]) end, fun ([{args, As}, {function, F}]) -> - Line = erl_syntax:get_pos(F), + Line = get_location(F), [F1|As1] = lists:map(fun erl_syntax:concrete/1, [F|As]), eval_call(Line, F1, As1, T) end}, @@ -118,7 +117,7 @@ expand_qquote(_As, T, _StartPos) -> expand_template(F, [Pattern | Args], T) -> case erl_syntax:is_literal(Pattern) of true -> - Line = erl_syntax:get_pos(Pattern), + Line = get_location(Pattern), As = [erl_syntax:concrete(Pattern)], merl:qquote(Line, "merl:_@function(_@pattern, _@args)", [{function, F}, @@ -260,3 +259,12 @@ is_erlang_var([C|_]) when C >= $A, C =< $Z ; C >= $À, C =< $Þ, C /= $× -> true; is_erlang_var(_) -> false. + +get_location(T) -> + Pos = erl_syntax:get_pos(T), + case erl_anno:is_anno(Pos) of + true -> + erl_anno:location(Pos); + false -> + Pos + end. diff --git a/lib/syntax_tools/test/Makefile b/lib/syntax_tools/test/Makefile index 569c044b1a..4ace860223 100644 --- a/lib/syntax_tools/test/Makefile +++ b/lib/syntax_tools/test/Makefile @@ -26,7 +26,7 @@ RELSYSDIR = $(RELEASE_PATH)/syntax_tools_test # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +ERL_COMPILE_FLAGS += EBIN = . diff --git a/lib/syntax_tools/test/merl_SUITE.erl b/lib/syntax_tools/test/merl_SUITE.erl index 125250395a..945972d405 100644 --- a/lib/syntax_tools/test/merl_SUITE.erl +++ b/lib/syntax_tools/test/merl_SUITE.erl @@ -16,7 +16,7 @@ %% -module(merl_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% include the Merl header file -include_lib("syntax_tools/include/merl.hrl"). diff --git a/lib/syntax_tools/test/syntax_tools_SUITE.erl b/lib/syntax_tools/test/syntax_tools_SUITE.erl index 40e00e0554..eb52cce6af 100644 --- a/lib/syntax_tools/test/syntax_tools_SUITE.erl +++ b/lib/syntax_tools/test/syntax_tools_SUITE.erl @@ -18,7 +18,7 @@ %% -module(syntax_tools_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Test server specific exports -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/lib/test_server/AUTHORS b/lib/test_server/AUTHORS deleted file mode 100644 index 3212999174..0000000000 --- a/lib/test_server/AUTHORS +++ /dev/null @@ -1,12 +0,0 @@ -Original Authors and Contributors: - -Mattias Nilsson -Bj�rn Gustavsson -Janne Lindblad -Patrik Winroth -Claes Wikstr�m -Siri Hansen -Peter Andersson - -...and others. - diff --git a/lib/test_server/Makefile b/lib/test_server/Makefile deleted file mode 100644 index 382749d1fc..0000000000 --- a/lib/test_server/Makefile +++ /dev/null @@ -1,39 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1996-2009. 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_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# -# Macros -# - -SUB_DIRECTORIES = src doc/src - -include vsn.mk -VSN = $(TEST_SERVER_VSN) - -SPECIAL_TARGETS = - -# -# Default Subdir Targets -# -include $(ERL_TOP)/make/otp_subdir.mk - diff --git a/lib/test_server/README b/lib/test_server/README deleted file mode 100644 index fc71c90ca8..0000000000 --- a/lib/test_server/README +++ /dev/null @@ -1,113 +0,0 @@ -=========================================================================== - OTP Test Server -=========================================================================== - -To compile the 'test_server' application you need to build and install -a Erlang/OTP system from source. Get your open source Erlang/OTP from -http://www.erlang.org/. The resulting "erlc" command must be in the -search path for commands. - -The Erlang test_server application and the example tests are to be -inserted into an existing source tree for Erlang/OTP. - -You don't run the Test Server or the tests from the source tree. -Instead a test installation area $TESTROOT is used with the resulting -directory structure - - $TESTROOT/test_server - $TESTROOT/<app1>_test - $TESTROOT/<app2>_test - . - . - -For more details see the test_server documentation can be found in the -"$ERL_TOP/lib/test_server/doc/html" directory. - - -Unpacking the sources ---------------------- - -Enter your Erlang/OTP source tree and unpack the OTP Test Server and -optionally the test examples - - % cd otp_src_RXX - % gunzip -c test_server-<VSN>.tar.gz | tar xf - - % gunzip -c emulator-YYYY-MM-DD.tar.gz | tar xf - - % gunzip -c stdlib-YYYY-MM-DD.tar.gz | tar xf - - - -How to build and install the OTP Test Server --------------------------------------------- - -Set the ERL_TOP variable to the top directory of the source tree - - % cd otp_src_RXX - - % setenv ERL_TOP `pwd` - or - % export ERL_TOP=`pwd` - -If not done before you need to run the configure script - - % ./configure - -Then build and install from the the base directory of the test_server -application - - % cd lib/test_server - % gmake release_tests TESTROOT=<some dir> - - -How to build and install the example test suites ------------------------------------------------- - -If you want to build and install the example test suites -you build and install from the the test directories - - % cd $ERL_TOP/lib/stdlib/test - % gmake release_tests TESTROOT=<some dir> - - % cd $ERL_TOP/erts/emulator/test - % gmake release_tests TESTROOT=<some dir> - - -How to run OTP test suites --------------------------- - -First cd into $TESTROOT/test_server - - % cd $TESTROOT/test_server - -Install the OTP Test Server framework - - % erl - 1> ts:install(). - -Check which tests are available - - 2> ts:tests(). - [...] - -Run the collections of test suites one at the time - - 3> ts:run(emulator). (starts a xterm with an Erlang shell) - 4> ts:run(stdlib). (starts a xterm with an Erlang shell) - -or all at once - - 5> ts:run(). (the node running the tests will be in the background) - -Note that it is normal to see lots of error messages in the Erlang -shell. The tests will stress the system with lots of invalid input to -find problems in the error handling. - -Also note that a failing test case does not always indicate a bug in -Erlang/OTP. Differences in the network setup, machine configuration -etc may cause a test case to fail or time out. - -The result of the tests are recorded in the file named "index.html" in -the "$TESTROOT/test_server" directory. You can follow the progress of -tests suites not yet completed from "last_test.html". - -For more details see the test_server documentation can be found in the -"$ERL_TOP/lib/test_server/doc/html" directory. diff --git a/lib/test_server/doc/html/.gitignore b/lib/test_server/doc/html/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/test_server/doc/html/.gitignore +++ /dev/null diff --git a/lib/test_server/doc/man3/.gitignore b/lib/test_server/doc/man3/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/test_server/doc/man3/.gitignore +++ /dev/null diff --git a/lib/test_server/doc/man6/.gitignore b/lib/test_server/doc/man6/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/test_server/doc/man6/.gitignore +++ /dev/null diff --git a/lib/test_server/doc/pdf/.gitignore b/lib/test_server/doc/pdf/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/test_server/doc/pdf/.gitignore +++ /dev/null diff --git a/lib/test_server/doc/src/Makefile b/lib/test_server/doc/src/Makefile deleted file mode 100644 index 8c5418aee5..0000000000 --- a/lib/test_server/doc/src/Makefile +++ /dev/null @@ -1,140 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 2002-2012. 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_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../../vsn.mk -VSN=$(TEST_SERVER_VSN) -APPLICATION=test_server - -DOC_EXTRA_FRONT_PAGE_INFO=Important note: \ -The Test Server application is obsolete and will be removed \ -in the next major OTP release - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- -XML_APPLICATION_FILES = ref_man.xml -XML_REF3_FILES = \ - test_server_ctrl.xml \ - test_server.xml -XML_REF3_INTERNAL = \ - ts.xml -XML_REF6_FILES = test_server_app.xml - -XML_PART_FILES = \ - part.xml \ - part_notes.xml \ - part_notes_history.xml - -XML_CHAPTER_FILES = \ - basics_chapter.xml \ - run_test_chapter.xml \ - write_test_chapter.xml \ - test_spec_chapter.xml \ - example_chapter.xml \ - write_framework_chapter.xml \ - notes.xml \ - notes_history.xml - -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) - -HTML_INTERNAL = $(XML_REF3_INTERNAL:%.xml=$(HTMLDIR)/%.html) - -INFO_FILE = ../../info - -MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -MAN3_INTERNAL = $(XML_REF3_INTERNAL:%.xml=$(MAN3DIR)/%.3) -MAN6_FILES = $(XML_REF6_FILES:%_app.xml=$(MAN6DIR)/%.6) - -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html - -TOP_PDF_FILE = $(PDFDIR)/test_server-$(VSN).pdf - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -$(HTMLDIR)/%.gif: %.gif - $(INSTALL_DATA) $< $@ - -docs: pdf html man - -pdf: $(TOP_PDF_FILE) - -html: gifs $(HTML_REF_MAN_FILE) - -man: $(MAN3_FILES) $(MAN3_INTERNAL) $(MAN6_FILES) - -gifs: $(GIF_FILES:%=$(HTMLDIR)/%) - -debug opt: - -clean clean_docs: - rm -rf $(HTMLDIR)/* - 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) $(MAN3_FILES) "$(RELEASE_PATH)/man/man3" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man6" - $(INSTALL_DATA) $(MAN6_FILES) "$(RELEASE_PATH)/man/man6" - -release_spec: - -release_tests_spec: diff --git a/lib/test_server/doc/src/basics_chapter.xml b/lib/test_server/doc/src/basics_chapter.xml deleted file mode 100644 index 9e9f38aab4..0000000000 --- a/lib/test_server/doc/src/basics_chapter.xml +++ /dev/null @@ -1,215 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE chapter SYSTEM "chapter.dtd"> - -<chapter> - <header> - <copyright> - <year>2002</year><year>2013</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>Test Server Basics</title> - <prepared>Siri Hansen</prepared> - <docno></docno> - <date></date> - <rev></rev> - <file>basics_chapter.xml</file> - </header> - - <section> - <title>Introduction</title> - <p><em>Test Server</em> is a portable test tool for automated - testing of Erlang programs and OTP applications. It provides an - interface for running test programs directly with Test Server - as well as an interface for integrating Test Server - with a framework application. The latter makes it possible to use - Test Server as the engine of a higher level test tool - application.</p> - - <p>It is strongly recommended that Test Server be used from inside - a framework application, rather than interfaced directly for - running test programs. Test Server can be pretty difficult to use - since it's a very general and quite extensive and complex - application. Furthermore, the <c>test_server_ctrl</c> functions - are not meant to be used from within the actual test programs. The - framework should handle communication with Test Server and deal - with the more complex aspects of this interaction automatically so - that a higher level interface may be provided for the tester. For - test tool usage to be productive, a simpler, more intuitive and - (if required) more specific interface is required than what Test Server - can provide.</p> - - <p>OTP delivers a general purpose framework for Test Server, called - <em>Common Test</em>. This application is a tool well suited for - automated black box testing of target systems of <em>any kind</em> - (not necessarily implemented in Erlang). Common Test is also a very - useful tool for white box testing of Erlang programs and OTP - applications. Unless a more specific functionality and/or user - interface is required (in which case you might need to implement - your own framework), Common Test should do the job for - you. Please read the Common Test User's Guide and reference manual - for more information.</p> - - <p>Under normal circumstances, knowledge about the Test Server - application is not required for using the Common Test framework. - However, if you want to use Test Server without a framework, - or learn how to integrate it with your own framework, please read on... - </p> - </section> - <section> - <title>Getting started</title> - <p>Testing when using Test Server is done by running test - suites. A test suite is a number of test cases, where each test - case tests one or more things. The test case is the smallest unit - that the test server deals with. One or more test cases are - grouped together into one ordinary Erlang module, which is called - a test suite. Several test suite modules can be grouped together - in special test specification files representing whole application - and/or system test "jobs". - </p> - <p>The test suite Erlang module must follow a certain interface, - which is specified by Test Server. See the section on writing - test suites for details about this. - </p> - <p>Each test case is considered a success if it returns to the - caller, no matter what the returned value is. An exception to this - is the return value <c>{skip, Reason}</c> which indicates that the - test case is skipped. A failure is specified as a crash, no matter - what the crash reason is. - </p> - <p>As a test suite runs, all information (including output to - stdout) is recorded in several different log files. A minimum of - information is displayed to the user console. This only include - start and stop information, plus a note for each failed test case. - </p> - <p>The result from each test case is recorded in an HTML log file - which is created for each test run. Every test case gets one row - in a table presenting total time, whether the case was successful - or not, if it was skipped, and possibly also a comment. The HTML - file has links to each test case's logfile, which may be viewed - from e.g. Netscape or any other HTML capable browser. - </p> - <p>The Test Server consists of three parts: - </p> - <list type="bulleted"> - <item>The part that executes the test suites and - provides support for the test suite author is called - <c>test_server</c>. This is described in the chapter about - writing test cases in this user's guide, and in the reference - manual for the <c>test_server</c> module.</item> - <item>The controlling part, which provides the low level - operator interface, starts and stops slave nodes and writes - log files, is called - <c>test_server_ctrl</c>. The Test Server Controller should not - be used directly when running tests. Instead a framework built - on top of it should be used. More information - about how to write your own framework can be found - in this user's guide and in the reference manual for the - <c>test_server_ctrl</c> module.</item> - </list> - </section> - - <section> - <title>Definition of terms</title> - <taglist> - <tag><em>conf(iguration) case</em></tag> - <item>This is a group of test cases which need some specific - configuration. A conf case contains an initiation function which - sets up a specific configuration, one or more test cases using - this configuration, and a cleanup function which restores the - configuration. A conf case is specified in a test specification - either like this:<c>{conf,InitFunc,ListOfCases,CleanupFunc}</c>, - or this: <c>{conf,Properties,InitFunc,ListOfCases,CleanupFunc}</c> - </item> - <tag><em>datadir</em></tag> - <item>Data directory for a test suite. This directory contains - any files used by the test suite, e.g. additional erlang - modules, c code or data files. If the data directory contains - code which must be compiled before the test suite is run, it - should also contain a makefile source called Makefile.src - defining how to compile. - </item> - <tag><em>documentation clause</em></tag> - <item>One of the function clauses in a test case. This clause - shall return a list of strings describing what the test case - tests. - </item> - <tag><em>execution clause</em></tag> - <item>One of the function clauses in a test case. This clause - implements the actual test case, i.e. calls the functions that - shall be tested and checks results. The clause shall crash if it - fails. - </item> - <tag><em>major log file</em></tag> - <item>This is the test suites log file. - </item> - <tag><em>Makefile.src</em></tag> - <item>This file is used by the test server framework to generate - a makefile for a datadir. It contains some special characters - which are replaced according to the platform currently tested. - </item> - <tag><em>minor log file</em></tag> - <item>This is a separate log file for each test case. - </item> - <tag><em>privdir</em></tag> - <item>Private directory for a test suite. This directory should - be used when the test suite needs to write to files. - </item> - <tag><em>skip case</em></tag> - <item>A test case which shall be skipped. - </item> - <tag><em>specification clause</em></tag> - <item>One of the function clauses in a test case. This clause - shall return an empty list, a test specification or - <c>{skip,Reason}</c>. If an empty list is returned, it means - that the test case shall be executed, and so it must also have - an execution clause. - </item> - <tag><em>test case</em></tag> - <item>A single test included in a test suite. Typically it tests - one function in a module or application. A test case is - implemented as a function in a test suite module. The function - can have three clauses, the documentation-, specification- and - execution clause. - </item> - <tag><em>test specification</em></tag> - <item>A specification of which test suites and test cases to - run. There can be test specifications on three different levels - in a test. The top level is a test specification file which - roughly specifies what to test for a whole application. Then - there is a test specification for each test suite returned from - the <c>all(suite)</c> function in the suite. And there can also - be a test specification returned from the specification clause - of a test case. - </item> - <tag><em>test specification file</em></tag> - <item>This is a text file containing the test specification for - an application. The file has the extension ".spec" or - ".spec.Platform", where Platform is e.g. "vxworks". - </item> - <tag><em>test suite</em></tag> - <item>An erlang module containing a collection of test cases for - a specific application or module. - </item> - <tag><em>topcase</em></tag> - <item>The first "command" in a test specification file. This - command contains the test specification, like this: - <c>{topcase,TestSpecification}</c></item> - </taglist> - </section> -</chapter> - diff --git a/lib/test_server/doc/src/book.xml b/lib/test_server/doc/src/book.xml deleted file mode 100644 index 6eb7daae1a..0000000000 --- a/lib/test_server/doc/src/book.xml +++ /dev/null @@ -1,50 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE book SYSTEM "book.dtd"> - -<book xmlns:xi="http://www.w3.org/2001/XInclude"> - <header titlestyle="normal"> - <copyright> - <year>2002</year><year>2013</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>Test Server</title> - <prepared>Siri Hansen</prepared> - <docno></docno> - <date>2002-07-11</date> - <rev></rev> - <file>book.xml</file> - </header> - <insidecover> - </insidecover> - <pagetext>Test Server</pagetext> - <preamble> - <contents level="2"></contents> - </preamble> - <parts lift="no"> - <xi:include href="part.xml"/> - </parts> - <applications> - <xi:include href="ref_man.xml"/> - </applications> - <releasenotes> - <xi:include href="notes.xml"/> - </releasenotes> - <listofterms></listofterms> - <index></index> -</book> - diff --git a/lib/test_server/doc/src/example_chapter.xml b/lib/test_server/doc/src/example_chapter.xml deleted file mode 100644 index ec152fdd6c..0000000000 --- a/lib/test_server/doc/src/example_chapter.xml +++ /dev/null @@ -1,151 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE chapter SYSTEM "chapter.dtd"> - -<chapter> - <header> - <copyright> - <year>2002</year><year>2013</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>Examples</title> - <prepared>Siri Hansen</prepared> - <docno></docno> - <date></date> - <rev></rev> - <file>example_chapter.xml</file> - </header> - - <section> - <title>Test suite</title> - <code type="none"> --module(my_SUITE). - --export([all/1, - not_started/1, not_started_func1/1, not_started_func2/1, - start/1, stop/1, - func1/1, func2/1 - ]). - --export([init_per_testcase/2, end_per_testcase/2]). - --include("test_server.hrl"). - --define(default_timeout, ?t:minutes(1)). - -init_per_testcase(_Case, Config) -> - Dog=?t:timetrap(?default_timeout), - [{watchdog, Dog}|Config]. -end_per_testcase(_Case, Config) -> - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog), - ok. - -all(suite) -> - %% Test specification on test suite level - [not_started, - {conf, start, [func1, func2], stop}]. - -not_started(suite) -> - %% Test specification on test case level - [not_started_func1, not_started_func2]; -not_started(doc) -> - ["Testing all functions when application is not started"]. -%% No execution clause unless the specification clause returns []. - - -not_started_func1(suite) -> - []; -not_started_func1(doc) -> - ["Testing function 1 when application is not started"]. -not_started_func1(Config) when list(Config) -> - {error, not_started} = myapp:func1(dummy_ref,1), - {error, not_started} = myapp:func1(dummy_ref,2), - ok. - -not_started_func2(suite) -> - []; -not_started_func2(doc) -> - ["Testing function 2 when application is not started"]. -not_started_func2(Config) when list(Config) -> - {error, not_started} = myapp:func2(dummy_ref,1), - {error, not_started} = myapp:func2(dummy_ref,2), - ok. - - -%% No specification clause needed for an init function in a conf case!!! -start(doc) -> - ["Testing start of my application."]; -start(Config) when list(Config) -> - Ref = myapp:start(), - case erlang:whereis(my_main_process) of - Pid when pid(Pid) -> - [{myapp_ref,Ref}|Config]; - undefined -> - %% Since this is the init function in a conf case, the rest of the - %% cases in the conf case will be skipped if this case fails. - ?t:fail("my_main_process did not start") - end. - -func1(suite) -> - []; -func1(doc) -> - ["Test that func1 returns ok when argument is 1 and error if argument is 2"]; -func1(Config) when list(Config) -> - Ref = ?config(myapp_ref,Config), - ok = myapp:func1(Ref,1), - error = myapp:func1(Ref,2), - ok. - -func2(suite) -> - []; -func2(doc) -> - ["Test that func1 returns ok when argument is 3 and error if argument is 4"]; -func2(Config) when list(Config) -> - Ref = ?config(myapp_ref,Config), - ok = myapp:func2(Ref,3), - error = myapp:func2(Ref,4), - ok. - -%% No specification clause needed for a cleanup function in a conf case!!! -stop(doc) -> - ["Testing termination of my application"]; -stop(Config) when list(Config) -> - Ref = ?config(myapp_ref,Config), - ok = myapp:stop(Ref), - case erlang:whereis(my_main_process) of - undefined -> - lists:keydelete(myapp_ref,1,Config); - Pid when pid(Pid) -> - ?t:fail("my_main_process did not stop") - end. - </code> - </section> - - <section> - <title>Test specification file</title> - <p><em><c>myapp.spec:</c></em></p> - <code type="none"> -{topcase, {dir, "../myapp_test"}}. % Test specification on top level </code> - <p><em><c>myapp.spec.vxworks:</c></em></p> - <code type="none"> -{topcase, {dir, "../myapp_test"}}. % Test specification on top level -{skip,{my_SUITE,func2,"Not applicable on VxWorks"}}. </code> - </section> -</chapter> - - diff --git a/lib/test_server/doc/src/fascicules.xml b/lib/test_server/doc/src/fascicules.xml deleted file mode 100644 index 37feca543f..0000000000 --- a/lib/test_server/doc/src/fascicules.xml +++ /dev/null @@ -1,18 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="part" href="part_frame.html" entry="no"> - User's Guide - </fascicule> - <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> - Reference Manual - </fascicule> - <fascicule file="part_notes" href="part_notes_frame.html" entry="no"> - Release Notes - </fascicule> - <fascicule file="" href="../../../../doc/print.html" entry="no"> - Off-Print - </fascicule> -</fascicules> - diff --git a/lib/test_server/doc/src/notes.xml b/lib/test_server/doc/src/notes.xml deleted file mode 100644 index b48bda94d0..0000000000 --- a/lib/test_server/doc/src/notes.xml +++ /dev/null @@ -1,1694 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE chapter SYSTEM "chapter.dtd"> - -<chapter> - <header> - <copyright> - <year>2004</year><year>2013</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>APPLICATION Release Notes</title> - <prepared>Peter Andersson</prepared> - <responsible>Peter Andersson</responsible> - <docno></docno> - <approved></approved> - <checked></checked> - <date>2007-11-30</date> - <rev>A</rev> - <file>notes.xml</file> - </header> - -<section><title>Test_Server 3.9.1</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - When generating Makefile from Makefile.src, - ts_lib:get_arg/4 earlier removed all spaces in the - extracted argument. The code was probably meant for - removing leading and trailing spaces only, and is now - corrected to do so.</p> - <p> - Own Id: OTP-13015</p> - </item> - <item> - <p> - With the Common Test 'create_priv_dir' start option set - to 'auto_per_tc', the name of the priv directory for a - configuration function could clash with the name of the - priv directory for a test case, which would cause Test - Server failure. This error has been corrected.</p> - <p> - Own Id: OTP-13181</p> - </item> - </list> - </section> - -</section> - -<section><title>Test_Server 3.9</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - The status of an aborted test due to test suite - compilation error has changed from 'auto_skipped' to - 'failed'. This affects both the textual log file, event - handling and CT hook callbacks. The logging of - compilation failures has also been improved, especially - in the case of multiple test suites failing compilation.</p> - <p> - Own Id: OTP-10816</p> - </item> - <item> - <p> - The Test Server source code parser (erl2html2) failed to - handle the macro tuple in the syntax tree returned by - epp_dodger. This error has been corrected.</p> - <p> - Own Id: OTP-12740</p> - </item> - </list> - </section> - - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - The Test Server application has been marked as obsolete - and will be removed from OTP in the next major release - (OTP 19.0).</p> - <p> - Own Id: OTP-10923 Aux Id: OTP-12705 </p> - </item> - <item> - <p> - When running OTP tests using the ts interface, it is now - possible to specify so called test categories per OTP - application. A test category is represented by a CT test - specification and defines an arbitrary subset of existing - test suites, groups and cases. Examples of test - categories are 'smoke' (smoke tests) and 'bench' - (benchmarks). (Call ts:help() for more info). Also, - functions for reading terms from the current test - specification during test, ct:get_testspec_terms/0 and - ct:get_testspec_terms/1, have been implemented.</p> - <p> - Own Id: OTP-11962</p> - </item> - </list> - </section> - -</section> - -<section><title>Test_Server 3.8.1</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - If the last expression in a test case causes a timetrap - timeout, the stack trace is ignored and not printed to - the test case log file. This happens because the - {Suite,TestCase,Line} info is not available in the stack - trace in this scenario, due to tail call elimination. - Common Test has been modified to handle this situation by - inserting a {Suite,TestCase,last_expr} tuple in the - correct place and printing the stack trace as expected.</p> - <p> - Own Id: OTP-12697 Aux Id: seq12848 </p> - </item> - </list> - </section> - -</section> - -<section><title>Test_Server 3.8</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - When installing test suites in a cross compilation - environment, ts_install was not able to read the values - of the environment variables specified in the - configuration file. This has been fixed.</p> - <p> - Own Id: OTP-11441</p> - </item> - <item> - <p> - Printouts by means of ct:log/2/3 or ct:pal/2/3 from the - hook functions on_tc_fail/2 and on_tc_skip/2 would (quite - unexpectedly) end up in the "unexpected i/o" log file - instead of in the test case log file. This behaviour has - been changed so that now, all printouts (including stdio - printouts) from these hook functions will be routed to - the test case log file.</p> - <p> - Own Id: OTP-12468</p> - </item> - </list> - </section> - - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - The format of the information printed on top of the test - case (and configuration function) log file has been - slightly modified, mainly in order to make the start - configuration data easier to read and interpret.</p> - <p> - Own Id: OTP-12518 Aux Id: seq12808 </p> - </item> - </list> - </section> - -</section> - -<section><title>Test_Server 3.7.2</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - The source code to html code generator in Test Server - (and Common Test) would fail to generate anchors in the - html code for functions with non-expandable macros, - resulting in bad html links to such functions. This - correction lets the code generator ignore macros that - can't be expanded (i.e. not pre-process them), so that - correct anchors will always be produced.</p> - <p> - Own Id: OTP-11766 Aux Id: seq12556 </p> - </item> - <item> - <p> - Make sure to install .hrl files when needed</p> - <p> - Own Id: OTP-12197</p> - </item> - </list> - </section> - - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - Distribute <c>autoconf</c> helpers to applications at - build time instead of having multiple identical copies - committed in the repository.</p> - <p> - Own Id: OTP-12348</p> - </item> - </list> - </section> - -</section> - -<section><title>Test_Server 3.7.1</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - The mechanism for running code cover analysis with - common_test has been improved. Earlier, if a test run - consisted of multiple tests, cover would be started and - stopped for each test. This would give "intermediate" - cover logs available from the "Coverage log" link on the - test suite result pages. To accumulate cover data over - all tests, the 'export' option had to be used in the - cover spec file. This was not well documented, and the - functionality was quite confusing.</p> - <p> - Using the 'nodes' option in the cover spec file would - fail when the test run consisted of multiple tests, since - the specified nodes would only be included in the cover - analysis of the first test.</p> - <p> - The repeated compilation and analysis of the same modules - was also very time consuming.</p> - <p> - To overcome these problems, ct will now only cover - compile and analyze modules once per test run, i.e. once - for each cover spec file. The log file is available via a - new button on the top level index page. The old "Coverage - log" links on the test suite result pages still exist, - but they all point to the same log containing the - accumulated result.</p> - <p> - Own Id: OTP-11971</p> - </item> - </list> - </section> - -</section> - -<section><title>Test_Server 3.7</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - Application upgrade (appup) files are corrected for the - following applications: </p> - <p> - <c>asn1, common_test, compiler, crypto, debugger, - dialyzer, edoc, eldap, erl_docgen, et, eunit, gs, hipe, - inets, observer, odbc, os_mon, otp_mibs, parsetools, - percept, public_key, reltool, runtime_tools, ssh, - syntax_tools, test_server, tools, typer, webtool, wx, - xmerl</c></p> - <p> - A new test utility for testing appup files is added to - test_server. This is now used by most applications in - OTP.</p> - <p> - (Thanks to Tobias Schlager)</p> - <p> - Own Id: OTP-11744</p> - </item> - </list> - </section> - - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - Calls to erlang:open_port/2 with 'spawn' are updated to - handle space in the command path.</p> - <p> - Own Id: OTP-10842</p> - </item> - </list> - </section> - -</section> - -<section><title>Test_Server 3.6.4</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p>The way Common Test handles skipping of test cases has - been updated. In previous versions, returning - <c>{skip,Reason}</c> from a configuration function (such - as init_per_suite or init_per_group), resulted in all - affected test cases getting skipped with status - <c>auto_skipped</c>. This was inappropriate, since this - status is supposed to be used to inform that Common Test - has taken the initiative to skip something (e.g. a test - case group if init_per_group failed). Therefore, in this - version of Common Test, whenever the user skips a suite, - group, or individual test case (by means of a - configuration function or test specification term), the - affected test cases get the status <c>user_skipped</c> - instead.</p> <p>This update has meant a few changes that - may affect Common Test users in various ways:</p> <list> - <item>The test results and statistics will be affected, - which is important to know when running regression tests - and comparing results to previous test runs.</item> - <item>Users that read or parse the textual log file - <c>suite.log</c> will notice that an auto skipped - function is now reported as <c>auto_skipped</c> rather - than <c>skipped</c> as before.</item> <item>When - <c>require</c> fails in an info function (such as suite/0 - or group/1), all affected configuration functions and - test cases are marked as <c>auto_skipped</c>.</item> - <item>If Common Test detects an error in the test suite - (such as e.g. an invalid all/0 function), all affected - configuration functions and test cases are marked as - <c>auto_skipped</c>.</item> <item>If a repeated test run - session reaches a deadline with <c>force_stop</c> - enabled, all remaining test cases are marked as - <c>auto_skipped</c> rather than <c>user_skipped</c> as - before.</item> <item>The event messages that Common Test - generates during test runs have been affected by this - update. For details see OTP-11524.</item> </list> - <p> - Own Id: OTP-11305 Aux Id: OTP-11524 </p> - </item> - </list> - </section> - -</section> - -<section><title>Test_Server 3.6.3</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - Test Server installed an error handler (test_server_h) - only to be able to write the name of the current test - case to stdout whenever it received an error- or progress - report. This functionality was not useful and has been - removed. The built-in Common Test hook, cth_log_redirect, - has instead been improved to now also tag all error- and - progress reports in the log with suite-, group-, and/or - test case name.</p> - <p> - Own Id: OTP-11263 Aux Id: seq12251 </p> - </item> - </list> - </section> - - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - A new log, the "Pre- and Post Test I/O Log", has been - introduced, which makes it possible to capture error- and - progress reports, as well as printouts made with ct:log/2 - and ct:pal/2, before and after a test run. (Some minor - improvements of the logging system have been made at the - same time). Links to the new log are found on the Common - Test Framework Log page. The Common Test User's Guide has - been updated with information about the new log and also - with a new section on how to synchronize external - applications with Common Test by means of the CT Hook - init and terminate functions.</p> - <p> - Own Id: OTP-11272</p> - </item> - </list> - </section> - - - <section><title>Known Bugs and Problems</title> - <list> - <item> - <p> - Test Server: Report auto_skipped in major log.</p> - <p> - Own Id: OTP-11297</p> - </item> - </list> - </section> - -</section> - -<section><title>Test_Server 3.6.2</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - Some unused code related to remote targets is removed, - and documentation is updated.</p> - <p> - Own Id: OTP-10607 Aux Id: kunagi-338 [249] </p> - </item> - <item> - <p> - A bug in test_server_gl caused io requests containing - invalid data (i.e. not unicode:chardata()) to hang, since - no io reply was sent. This has been corrected.</p> - <p> - Own Id: OTP-10991</p> - </item> - <item> - <p> - Common Test would, in case of timetrap error, print a - warning in the log if end_per_testcase wasn't implemented - in the suite, even though it's an optional function. This - printout has been removed.</p> - <p> - Own Id: OTP-11052</p> - </item> - </list> - </section> - - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - The '-force_stop' flag to use with time-limited repeats - of test runs can now be used with a new 'skip_rest' - option which causes the rest of the test cases in the - ongoing test job to be skipped when the time limit is - reached. E.g. 'ct_run -spec xxx -duration 010000 - -force_stop skip_rest'</p> - <p> - Own Id: OTP-10856 Aux Id: OTP-10832 </p> - </item> - </list> - </section> - -</section> - -<section><title>Test_Server 3.6.1</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - The unicode update of test_server for R16A introduced a - few potential errors when logging to files. Sometimes ~tp - or ~ts was used for formatting also when writing to files - that were not opened with the {encoding,utf8} option. If - then the argument contained unicode characters above 255, - the file descriptor would crash. This has been corrected - by the following modifications:</p> <list> <item> Since the - 'unexpected_io' log file is used only when the test case - HTML file is not available (e.g. between test cases), - this file is now also a HTML file and as other - test_server HTML logs it is always UTF-8 encoded </item> - <item> Since it is possible to change which information - is going to which log file (with - test_server_ctrl:set_levels/3), we do not have full - control over which information is written to which file. - This means that any printout could be written to the - 'major' log file (suite.log), which was earlier encoded - as latin1. To avoid crashing this file descriptor due to - unicode strings, the 'major' log file is now also encoded - in UTF-8 (possible incopatibility). </item> <item> The - cross_cover.info file is no longer a text file which can - be read with file:consult/1, instead it is written as a - pure binary file using term_to_binary when writing and - binary_to_term when reading. </item> <item> The encoding - of the file named 'last_name', which only content is the - path to the last run.<timestamp> directory, is now - dependent on the file name mode of the VM. If file names - are expected to be unicode, then the 'last_name' file is - UTF-8 encoded, else it is latin1 encoded. </item> </list> - <p> - Also, ~tp has been changed back to ~p unless it is - somehow likely that the argument includes strings. It is - not obvious that this is the correct thing to do, but - some decission had to be taken...</p> - <p> - Own Id: OTP-10780</p> - </item> - <item> - <p> - Using the force_stop flag/option to interrupt a test run - caused a crash in Common Test. This problem has been - solved.</p> - <p> - Own Id: OTP-10832</p> - </item> - </list> - </section> - -</section> - -<section><title>Test_Server 3.6</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - Line numbering of erlang files that were not correctly - indented could be wrong after coverting to html with - erl2html2:convert/[2,3] (the source code pointed to from - the test case). This has been corrected.</p> - <p> - Also, there are now link targets for each line and not - only for each 10th line, and link targets for functions - now include the arity and not only the function name - (e.g. func/1 has a link target "func-1").</p> - <p> - Own Id: OTP-9710 Aux Id: seq11945, kunagi-201 [112] </p> - </item> - <item> - <p> - Severe errors detected by <c>test_server</c> (e.g. if log - files directories cannot be created) will now be reported - to <c>common_test</c> and noted in the <c>common_test</c> - logs.</p> - <p> - Own Id: OTP-9769 Aux Id: kunagi-202 [113] </p> - </item> - <item> - <p> - The earlier undocumented cross cover feature for - accumulating cover data over multiple tests has now been - fixed and documented.</p> - <p> - Own Id: OTP-9870 Aux Id: kunagi-206 [117] </p> - </item> - <item> - <p> - If the test suite itself was included in code coverage - analysis, then the test_server would not manage to set - data_dir correctly for the test. This has been corrected.</p> - <p> - Own Id: OTP-9956 Aux Id: kunagi-207 [118] </p> - </item> - <item> - <p> - Any call to test_server:break/1 should cancel all active - timetramps. However, in some cases - Suite:end_per_testcase/2 is executed on a different - process than the test case itself, and if - test_server:break/1 was called from there, the timetraps - were not cancelled. This has been corrected.</p> - <p> - Own Id: OTP-10046 Aux Id: kunagi-174 [85] </p> - </item> - <item> - <p>When a test case failed because of a timetrap time - out, the <c>Config</c> data for the case was lost in the - following call to <c>end_per_testcase/2</c>, and also in - calls to the CT Hook function - <c>post_end_per_testcase/4</c>. This problem has been - solved and the <c>Config</c> data is now correctly passed - to the above functions after a timetrap timeout - failure.</p> - <p> - Own Id: OTP-10070 Aux Id: kunagi-175 [86] </p> - </item> - <item> - <p>In test_server, the same process would supervise the - currently running test case and be group leader (and IO - server) for the test case. Furthermore, when running - parallel test cases, new temporary supervisor/group - leader processes were spawned and the process that was - group leader for sequential test cases would not be - active. That would lead to several problems:</p> - <p>* Processes started by init_per_suite will inherit the - group leader of the init_per_suite process (and that - group leader would not process IO requests when parallel - test cases was running). If later a parallel test case - caused such a processto print using (for example) - io:format/2, the calling would hang.</p> - <p>* Similarly, if a process was spawned from a parallel - test case, it would inherit the temporary group leader - for that parallel test case. If that spawned process - later - when the group of parallel tests have finished - - attempted to print something, its group leader would be - dead and there would be <c>badarg</c> exception.</p> - <p>Those problems have been solved by having group - leaders separate from the processes that supervises the - test cases, and keeping temporary group leader process - for parallel test cases alive until no more process in - the system use them as group leaders.</p> - <p>Also, a new <c>unexpected_io.log</c> log file - (reachable from the summary page of each test suite) has - been introduced. All unexpected IO will be printed into - it(for example, IO to a group leader for a parallel test - case that has finished).</p> - <p> - Own Id: OTP-10101 Aux Id: OTP-10125 </p> - </item> - <item> - <p> - The stability of <c>common_test</c> and - <c>test_server</c> when running test cases in parallel - has been improved.</p> - <p> - Own Id: OTP-10480 Aux Id: kunagi-318 [229] </p> - </item> - </list> - </section> - - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - Added a general framework for executing benchmarks of - Erlang/OTP. Benchmarks for the Erlang VM and mnesia have - been incorporated in the framework. </p> - <p> - For details about how to add more benchmarks see - $ERL_TOP/HOWTO/BENCHMARKS.md in the source distribution.</p> - <p> - Own Id: OTP-10156</p> - </item> - <item> - <p> - Update common test modules to handle Unicode:</p> <list> - <item> Use UTF-8 encoding for all HTML files, except the - HTML version of the test suite generated with - erl2html2:convert, which will have the same encoding as - the original test suite (.erl) file. </item> <item> - Encode link targets in HTML files with - test_server_ctrl:uri_encode/1. </item> <item> Use unicode - modifier 't' with ~s when appropriate. </item> <item> Use - unicode:characters_to_list and - unicode:characters_to_binary for conversion between - binaries and strings instead of binary_to_list and - list_to_binary. </item> </list> - </item> - </list> - </section> - -</section> - -<section><title>Test_Server 3.5.3</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - test_server_h will now recognize info_reports written by - ct connection handlers (according to the description in - cth_conn_log) and ignore them as they will be completely - handled by by ct_conn_log_h.</p> - <p> - Earlier test_server_h would print a tag (testcase name) - before forwarding the report to error_logger_tty_h. This - would cause lots of tags in the log with no info report - following (since error_logger_tty_h did not handle them).</p> - <p> - Own Id: OTP-10571</p> - </item> - </list> - </section> - - - <section><title>Known Bugs and Problems</title> - <list> - <item> - <p> - Restore Config data if lost when test case fails.</p> - <p> - Own Id: OTP-10070 Aux Id: kunagi-175 [86] </p> - </item> - <item> - <p> - IO server error in test_server.</p> - <p> - Own Id: OTP-10125 Aux Id: OTP-10101, kunagi-177 [88] </p> - </item> - </list> - </section> - -</section> - -<section><title>Test_Server 3.5.2</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - The documentation has been updated with the latest - changes for the test_server_ctrl:report/2 function.</p> - <p> - Own Id: OTP-10086 Aux Id: seq12066 </p> - </item> - <item> - <p> - The ct:get_status/0 function failed to report status if a - parallel test case group was running at the time of the - call. This has been fixed and the return value for the - function has been updated. Please see the ct reference - manual for details.</p> - <p> - Own Id: OTP-10172</p> - </item> - </list> - </section> - - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - It is now possible to sort the HTML tables by clicking on - the header elements. In order to reset a sorted table, - the browser window should simply be refreshed. This - feature requires that the browser supports javascript, - and has javascript execution enabled. If the 'ct_run - -basic_html' flag is used, no javascript code is included - in the generated HTML code.</p> - <p> - Own Id: OTP-9896 Aux Id: seq12034, OTP-9835 </p> - </item> - <item> - <p> - Verbosity levels for log printouts has been added. This - makes it possible to specify preferred verbosity for - different categories of log printouts, as well as general - printouts (such as standard IO), to allow control over - which strings get printed and which get ignored. New - versions of the Common Test logging functions, ct:log, - ct:pal and ct:print, have been introduced, with a new - Importance argument added. The Importance value is - compared to the verbosity level at runtime. More - information can be found in the chapter about Logging in - the Common Test User's Guide.</p> - <p> - Own Id: OTP-10067 Aux Id: seq12050 </p> - </item> - <item> - <p> - The Erlang/OTP test runner ts has been extended to allow - cross compilation of test suites. To cross compile the - test suites first follow the normal cross compilation - procedures and release the tests on the build host. Then - install ts using an xcomp specification file and compile - test suites using ts:compile_testcases/0. For more - details see $ERL_TOP/xcomp/README.md.</p> - <p> - Own Id: OTP-10074</p> - </item> - </list> - </section> - -</section> - -<section><title>Test_Server 3.5.1</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - After a test case timeout or abortion, the - end_per_testcase function executes on a new dedicated - process. The group leader for this process should be set - to the IO server for the test case, which was not done - properly. The result of this error was that no warnings - about end_per_testcase failing or timing out were ever - printed in the test case log. Also, help functions such - as e.g. test_server:stop_node/1, attempting to - synchronize with the IO server, would hang. The fault has - been corrected.</p> - <p> - Own Id: OTP-9666</p> - </item> - <item> - <p> - A deadlock situation could occur if Common Test is - forwarding error_handler printouts to Test Server at the - same time a new test case is starting. This error has - been fixed.</p> - <p> - Own Id: OTP-9894</p> - </item> - <item> - <p> - When a test case was killed because of a timetrap - timeout, the current location (suite, case and line) was - not printed correctly in the log files. This has been - corrected.</p> - <p> - Own Id: OTP-9930 Aux Id: seq12002 </p> - </item> - <item> - <p> - Test Server and Common Test would add new error handlers - with each test run and fail to remove previously added - ones. In the case of Test Server, this would only happen - if SASL was not running on the test node. This has been - fixed.</p> - <p> - Own Id: OTP-9941 Aux Id: seq12009 </p> - </item> - <item> - <p> - If a test case process was terminated due to an exit - signal from a linked process, Test Server failed to - report the correct name of the suite and case to the - framework. This has been corrected.</p> - <p> - Own Id: OTP-9958 Aux Id: OTP-9855 </p> - </item> - </list> - </section> - - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - A new optional feature has been introduced that enables - Common Test to generate priv_dir directory names that are - unique for each test case or config function. The name of - the option/flag is 'create_priv_dir' and it can be set to - value 'auto_per_run' (which is the default, existing, - behaviour), or 'auto_per_tc' or 'manual_per_tc'. If - 'auto_per_tc' is used, Test Server creates a dedicated - priv_dir automatically for each test case (which can be - very expensive in case of many and/or repeated cases). If - 'manual_per_tc' is used, the user needs to create the - priv_dir explicitly by calling the new function - ct:make_priv_dir/0.</p> - <p> - Own Id: OTP-9659 Aux Id: seq11930 </p> - </item> - <item> - <p> - A column for test case group name has been added to the - suite overview HTML log file.</p> - <p> - Own Id: OTP-9730 Aux Id: seq11952 </p> - </item> - <item> - <p> - It is now possible to use the post_end_per_testcase CT - hook function to print a comment for a test case in the - overview log file, even if the test case gets killed by a - timetrap or unknown exit signal, or if the - end_per_testcase function times out.</p> - <p> - Own Id: OTP-9855 Aux Id: seq11979 </p> - </item> - <item> - <p> - Common Test will now print error information (with a time - stamp) in the test case log file immediately when a test - case fails. This makes it easier to see when, in time, - the fault actually occured, and aid the job of locating - relevant trace and debug printouts in the log.</p> - <p> - Own Id: OTP-9904 Aux Id: seq11985, OTP-9900 </p> - </item> - <item> - <p> - Test Server has been modified to check the SASL - errlog_type parameter when receiving an error logger - event, so that it doesn't print reports of type that the - user has disabled.</p> - <p> - Own Id: OTP-9955 Aux Id: seq12013 </p> - </item> - <item> - <p> - If an application cannot be found by ts it is - automatically skipped when testing.</p> - <p> - Own Id: OTP-9971</p> - </item> - <item> - <p> - By specifying a user defined function ({M,F,A} or fun) as - timetrap value, either by means of an info function or by - calling ct:timetrap/1, it is now possible to set a - timetrap that will be triggered when the user function - returns.</p> - <p> - Own Id: OTP-9988 Aux Id: OTP-9501, seq11894 </p> - </item> - <item> - <p> - If the optional configuration functions init_per_suite/1 - and end_per_suite/1 are not implemented in the test - suite, local Common Test versions of these functions are - called instead, and will be displayed in the overview log - file. Any printouts made by the pre- or - post_init_per_suite and pre- or post_end_per_suite hook - functions are saved in the log files for these functions.</p> - <p> - Own Id: OTP-9992</p> - </item> - </list> - </section> - -</section> - -<section><title>Test_Server 3.5</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - The test case group info function has been implemented in - Common Test. Before execution of a test case group, a - call is now made to <c>TestSuite:group(GroupName)</c>. - The function returns a list of test properties, e.g. to - specify timetrap values, require configuration data, etc - (analogue to the test suite- and test case info - function). The scope of the properties set by - <c>group(GroupName)</c> is all test cases and sub-groups - of group <c>GroupName</c>.</p> - <p> - Own Id: OTP-9235</p> - </item> - <item> - <p> - The look of the HTML log files generated by Common Test - and Test Server has been improved (and made easier to - customize) by means of a CSS file.</p> - <p> - Own Id: OTP-9706</p> - </item> - </list> - </section> - - - <section><title>Known Bugs and Problems</title> - <list> - <item> - <p> - Fix problems in CT/TS due to line numbers in exceptions.</p> - <p> - Own Id: OTP-9203</p> - </item> - </list> - </section> - -</section> - -<section><title>Test_Server 3.4.5</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - An error in how comments are colored in the test suite - overview html log file has been corrected. As result, a - new framework callback function, format_comment/1, has - been introduced.</p> - <p> - Own Id: OTP-9237</p> - </item> - <item> - <p> - Test Server did not release SASL TTY handlers - (sasl_report_tty_h and error_logger_tty_h) properly after - each test run. This error has been fixed.</p> - <p> - Own Id: OTP-9311</p> - </item> - <item> - <p> - Automatically generated init- and end-configuration - functions for test case groups caused incorrect execution - order of test cases. This has been corrected.</p> - <p> - Own Id: OTP-9369</p> - </item> - <item> - <p> - If ct:log/2 was called with bad arguments, this could - cause the Common Test IO handling process to crash. This - fault has been corrected.</p> - <p> - Own Id: OTP-9371 Aux Id: OTP-8933 </p> - </item> - <item> - <p> - A bug has been fixed that made Test Server call the - end_tc/3 framework function with an incorrect module name - as first argument.</p> - <p> - Own Id: OTP-9379 Aux Id: seq11863 </p> - </item> - <item> - <p> - If end_per_testcase caused a timetrap timeout, the actual - test case status was discarded and the test case logged - as successful (even if the case had actually failed - before the call to end_per_testcase). This fault has been - fixed.</p> - <p> - Own Id: OTP-9397</p> - </item> - <item> - <p> - If a timetrap timeout occured during execution of of a - function in a lib module (i.e. a function called directly - or indirectly from a test case), the Suite argument in - the end_tc/3 framework callback function would not - correctly contain the name of the test suite, but the lib - module. (This would only happen if the lib module was - compiled with ct.hrl included). This error has been - solved.</p> - <p> - Own Id: OTP-9398</p> - </item> - <item> - <p> - Add a proplist() type</p> - <p> - Recently I was adding specs to an API and found that - there is no canonical proplist() type defined. (Thanks to - Ryan Zezeski)</p> - <p> - Own Id: OTP-9499</p> - </item> - <item> - <p> XML files have been corrected. </p> - <p> - Own Id: OTP-9550 Aux Id: OTP-9541 </p> - </item> - <item> - <p> - If a test suite would start with a test case group - defined without the init_per_group/2 and end_per_group/2 - function, init_per_suite/1 would not execute initially - and logging of the test run would fail. This error has - been fixed.</p> - <p> - Own Id: OTP-9584</p> - </item> - </list> - </section> - - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - A new option, 'logopts', has been introduced, to make it - possible to modify some aspects of the logging behaviour - in Common Test (or Test Server). For example, whenever an - io printout is made, test_server adds newline (\n) to the - end of the output string. This may not always be a - preferred action and can therefore be disabled by means - of "ct_run ... -logopts no_nl" (or ct:run_test([..., - {logopts,[no_nl]}])). A new framework callback function, - get_logopts/0, has been introduced (see the ct_framework - module for details).</p> - <p> - Own Id: OTP-9372 Aux Id: OTP-9396 </p> - </item> - <item> - <p> - A new option, 'logopts', has been introduced, to make it - possible to modify some aspects of the logging behaviour - in Common Test (or Test Server). For example, if the html - version of the test suite source code should not be - generated during the test run (and consequently be - unavailable in the log file system), the feature may be - disabled by means of "ct_run ... -logopts no_src" (or - ct:run_test([..., {logopts,[no_src]}])). A new framework - callback function, get_logopts/0, has been introduced - (see the ct_framework module for details).</p> - <p> - Own Id: OTP-9396 Aux Id: seq11869, OTP-9372 </p> - </item> - <item> - <p> - It is now possible to use a tuple {M,F,A}, or a fun, as - timetrap specification in the suite info function or test - case info functions. The function must return a valid - timeout value, as documented in the common_test man page - and in the User's Guide.</p> - <p> - Own Id: OTP-9501 Aux Id: seq11894 </p> - </item> - </list> - </section> - -</section> - -<section><title>Test_Server 3.4.4</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - It was previously not possible to use timetrap value - 'infinity' with ct:timetrap/1. This has been fixed.</p> - <p> - Own Id: OTP-9159</p> - </item> - <item> - <p> - A bug that made it impossible to cancel the previous - timetrap when calling ct:timetrap/1 has been corrected.</p> - <p> - Own Id: OTP-9233 Aux Id: OTP-9159 </p> - </item> - </list> - </section> - - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - When running tests with auto-compilation disabled, Common - Test could only display the test suite source code on - html format in the test case log if the source file was - located in the same directory as the pre-compiled suite. - This has been modified so that Common Test now tries to - locate the source file by means of the test suite module - info (Suite:module_info/1). As a result, a suite may now - be compiled to a different output directory (e.g. - $MYTEST/bin) than the source code directory (e.g. - $MYTEST/src), without the source-code-to-html generation - being affected.</p> - <p> - Own Id: OTP-9138</p> - </item> - <item> - <p> - It is now possible to return a tuple {fail,Reason} from - init_per_testcase/2. The result is that the associated - test case gets logged as failed without ever executing.</p> - <p> - Own Id: OTP-9160 Aux Id: seq11502 </p> - </item> - <item> - <p> - Added DragonflyBSD check in test_server configure.</p> - <p> - Own Id: OTP-9249</p> - </item> - </list> - </section> - -</section> - -<section><title>Test_Server 3.4.3</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - Updated the ts*.config files to contain information - relevant to testing Erlang/OTP in an open source - environment.</p> - <p> - Own Id: OTP-9017</p> - </item> - </list> - </section> - - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - Alpha release of Common Test Hooks (CTH). CTHs allow the - users of common test to abtract out common behaviours - from test suites in a much more elegant and flexible way - than was possible before. Note that the addition of this - feature may introduce minor changes in the undocumented - behaviour of the interface inbetween common_test and - test_server.</p> - <p> - *** POTENTIAL INCOMPATIBILITY ***</p> - <p> - Own Id: OTP-8851</p> - </item> - </list> - </section> - -</section> - -<section><title>Test_Server 3.4.2</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p>Miscellaneous updates</p> - <p> - Own Id: OTP-8976</p> - </item> - </list> - </section> - -</section> - -<section><title>Test_Server 3.4.1</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - Returning {return_group_result,failed} from end_per_group - in a group that is part of a sequence, did not cause the - proceeding cases (or groups) to get skipped. This has - been fixed.</p> - <p> - Own Id: OTP-8753 Aux Id: seq11644 </p> - </item> - </list> - </section> - - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - Common Test has been updated to handle start options and - test specification terms for test case groups (and test - cases in groups). Also, an option named 'label', has been - added that associates the test run with a name that - Common Test prints in the overview HTML logs.</p> - <p> - Own Id: OTP-8725 Aux Id: OTP-8727 </p> - </item> - <item> - <p> - It is now possible to skip all tests in a suite, or a - group, by returning {fail,Reason} from the end_tc/5 - framework function for init_per_suite, or init_per_group.</p> - <p> - Own Id: OTP-8805 Aux Id: seq11664 </p> - </item> - </list> - </section> - -</section> - -<section><title>Test_Server 3.4</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - Returning {fail,Reason} from the framework end_tc - function was not handled properly by Test Server for all - test suite functions.</p> - <p> - Own Id: OTP-8492 Aux Id: seq11502 </p> - </item> - <item> - <p> - If the framework end_tc function would hang and get - aborted by Test Server, there was no indication of - failure in the logs. This has been fixed.</p> - <p> - Own Id: OTP-8682 Aux Id: seq11504 </p> - </item> - </list> - </section> - - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - It is now possible for the Test Server framework end_tc - function to change the status of the test case from ok or - auto-skipped to failed by returning {fail,Reason}.</p> - <p> - Own Id: OTP-8495 Aux Id: seq11502 </p> - </item> - <item> - <p> - Test Server will now call the end_per_testcase/2 function - even if the test case has been terminated explicitly - (with abort_current_testcase/1), or after a timetrap - timeout. Under these circumstances the return value of - end_per_testcase is completely ignored. Therefore the - function will not be able to change the reason for test - case termination by returning {fail,Reason}, nor will it - be able to save data with {save_config,Data}.</p> - <p> - Own Id: OTP-8500 Aux Id: seq11521 </p> - </item> - <item> - <p> - Previously, a repeat property of a test case group - specified the number of times the group should be - repeated after the main test run. I.e. {repeat,N} would - case the group to execute 1+N times. To be consistent - with the behaviour of the run_test repeat option, this - has been changed. N now specifies the absolute number of - executions instead.</p> - <p> - Own Id: OTP-8689 Aux Id: seq11502 </p> - </item> - </list> - </section> - -</section> - -<section><title>Test_Server 3.3.6</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - The Test Server parse transform did not handle bit string - comprehensions. This has been fixed.</p> - <p> - Own Id: OTP-8458 Aux Id: OTP-8311 </p> - </item> - </list> - </section> - - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - The tc_status value in the Config list for a test case - that has failed because of a timetrap timeout, has - changed from {tc_status,timeout} to - {tc_status,timetrap_timeout}.</p> - <p> - Own Id: OTP-8302</p> - </item> - <item> - <p>The documentation is now possible to build in an open - source environment after a number of bugs are fixed and - some features are added in the documentation build - process. </p> - <p>- The arity calculation is updated.</p> - <p>- The module prefix used in the function names for - bif's are removed in the generated links so the links - will look like - "http://www.erlang.org/doc/man/erlang.html#append_element-2" - instead of - "http://www.erlang.org/doc/man/erlang.html#erlang:append_element-2".</p> - <p>- Enhanced the menu positioning in the html - documentation when a new page is loaded.</p> - <p>- A number of corrections in the generation of man - pages (thanks to Sergei Golovan)</p> - <p>- The legal notice is taken from the xml book file so - OTP's build process can be used for non OTP - applications.</p> - <p> - Own Id: OTP-8343</p> - </item> - </list> - </section> - -</section> - -<section><title>Test_Server 3.3.5</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - If the init_per_testcase/2 function fails, the test case - now gets marked and counted as auto skipped, not user - skipped (which would previously happen).</p> - <p> - Own Id: OTP-8289</p> - </item> - </list> - </section> - - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - The documentation is now built with open source tools - (xsltproc and fop) that exists on most platforms. One - visible change is that the frames are removed.</p> - <p> - Own Id: OTP-8201</p> - </item> - <item> - <p> - It is now possible to fail a test case from the - end_per_testcase/2 function, by returning {fail,Reason}.</p> - <p> - Own Id: OTP-8284</p> - </item> - <item> - <p> - It is now possible to fail a test case by having the - end_tc/3 framework function return {fail,Reason} for the - test case.</p> - <p> - Own Id: OTP-8285</p> - </item> - <item> - <p> - The test_server framework API (e.g. the end_tc/3 - function) has been modified. See the test_server_ctrl - documentation for details.</p> - <p> - Own Id: OTP-8286 Aux Id: OTP-8285, OTP-8287 </p> - </item> - </list> - </section> - -</section> - -<section><title>Test_Server 3.3.4</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - When running a suite starting with a test case group, - Test Server crashed if init_per_suite/1 exited or - returned skip. This has been fixed.</p> - <p> - Own Id: OTP-8105 Aux Id: OTP-8089 </p> - </item> - </list> - </section> - - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - Various updates and fixes in Common Test and Test Server.</p> - <p> - Own Id: OTP-8045 Aux Id: OTP-8089,OTP-8105,OTP-8163 </p> - </item> - <item> - <p> - Errors in coverage data collection and analysis were - difficult to detect. The logging has been improved so - that more information about e.g. imported and missing - modules is printed to the html log files.</p> - <p> - Own Id: OTP-8163 Aux Id: seq11374 </p> - </item> - <item> - <p> - The Common Test HTML overview pages have been improved. - It is now possible to see if a test case has been skipped - explicitly or because a configuration function has - failed. Also, the history page (all_runs.html) now has - scrolling text displaying the test names. The old format - (showing names as a truncated string) can still be - generated by means of the flag/option 'basic_html'.</p> - <p> - Own Id: OTP-8177</p> - </item> - </list> - </section> - -</section> - -<section><title>Test_Server 3.3.2</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - Various corrections and improvements of Common Test and - Test Server.</p> - <p> - Own Id: OTP-7981</p> - </item> - </list> - </section> - -</section> - -<section><title>Test_Server 3.3.1</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - Minor updates and corrections.</p> - <p> - Own Id: OTP-7897</p> - </item> - </list> - </section> - -</section> - -<section><title>Test_Server 3.3</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - The conf case in Test Server has been extended with - properties that make it possible to execute test cases in - parallel, in sequence and in shuffled order. It is now - also possible to repeat test cases according to different - criterias. The properties can be combined, making it - possible to e.g. repeat a conf case a certain number of - times and execute the test cases in different (random) - order every time. The properties are specified in a list - in the conf case definition: {conf, Properties, InitCase, - TestCases, EndCase}. The available properties are: - parallel, sequence, shuffle, repeat, repeat_until_all_ok, - repeat_until_any_ok, repeat_until_any_fail, - repeat_until_all_fail.</p> - <p> - Own Id: OTP-7511 Aux Id: OTP-7839 </p> - </item> - <item> - <p>The test server starts Cover on nodes of the same - version as the test server itself only.</p> - <p> - Own Id: OTP-7699</p> - </item> - <item> - <p> - The Erlang mode for Emacs has been updated with new and - modified skeletons for Common Test and TS. Syntax for - test case groups in Common Test (and conf cases with - properties in TS) has been added and a new minimal Common - Test suite skeleton has been introduced.</p> - <p> - Own Id: OTP-7856</p> - </item> - </list> - </section> - -</section> -<section><title>Test_Server 3.2.4.1</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - The step functionality in Common Test (based on - interaction with Debugger) was broken. This has been - fixed, and some new step features have also been added. - Please see the Common Test User's Guide for details.</p> - <p> - Own Id: OTP-7800 Aux Id: seq11106 </p> - </item> - </list> - </section> - -</section> - -<section><title>Test_Server 3.2.4</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - Miscellaneous updates.</p> - <p> - Own Id: OTP-7527</p> - </item> - </list> - </section> - -</section> - -<section><title>Test_Server 3.2.3</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - When a testcase terminated due to a timetrap, io sent to - the group leader from framework:end_tc/3 (using - ct:pal/2/3 or ct:log/2/3) would cause deadlock. This has - been fixed.</p> - <p> - Own Id: OTP-7447 Aux Id: seq11010 </p> - </item> - </list> - </section> - - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - Various updates and improvements, plus some minor bug - fixes, have been implemented in Common Test and Test - Server.</p> - <p> - Own Id: OTP-7112</p> - </item> - <item> - <p> - It is now possible, by means of the new function - ct:abort_current_testcase/1 or - test_server_ctrl:abort_current_testcase/1, to abort the - currently executing test case.</p> - <p> - Own Id: OTP-7518 Aux Id: OTP-7112 </p> - </item> - </list> - </section> - -</section> - -<section><title>Test_Server 3.2.2</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p><c>erlang:system_info/1</c> now accepts the - <c>logical_processors</c>, and <c>debug_compiled</c> - arguments. For more info see the, <c>erlang(3)</c> - documentation.</p> <p>The scale factor returned by - <c>test_server:timetrap_scale_factor/0</c> is now also - effected if the emulator uses a larger amount of - scheduler threads than the amount of logical processors - on the system. </p> - <p> - Own Id: OTP-7175</p> - </item> - </list> - </section> - -</section> - -<section><title>Test_Server 3.2.1</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - When init_per_suite or end_per_suite terminated due to - runtime failure, test_server failed to format the line - number information properly and crashed. This error has - now been fixed.</p> - <p> - Own Id: OTP-7091</p> - </item> - </list> - </section> - -</section> - -<section><title>Test_Server 3.2.0</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - Test Server is a portable test server for automated - application testing. The server can run test suites on - local or remote targets and log progress and results to - HTML pages. The main purpose of Test Server is to act as - engine inside customized test tools. A callback interface - for such framework applications is provided.</p> - <p> - Own Id: OTP-6989</p> - </item> - </list> - </section> - -</section> - -</chapter> - diff --git a/lib/test_server/doc/src/notes_history.xml b/lib/test_server/doc/src/notes_history.xml deleted file mode 100644 index ca7880d74f..0000000000 --- a/lib/test_server/doc/src/notes_history.xml +++ /dev/null @@ -1,113 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE chapter SYSTEM "chapter.dtd"> - -<chapter> - <header> - <copyright> - <year>2006</year><year>2013</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>Test Server Release Notes History</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - </header> - - <section> - <title>Test Server 3.1.1</title> - - <section> - <title>Improvements and new features</title> - <list type="bulleted"> - <item> - <p>Added functions <c>test_server:break/1</c> and - <c>test_server:continue/0</c> for semiautomatic testing.</p> - <p><c>test_server:timetrap/1</c> can now also take - <c>{hours,H} | {minutes,M | {seconds,S}</c>.</p> - <p>Added function - <c>test_server_ctrl:multiply_timetraps/1</c>, - <c>test_server_ctrl:add_case/3</c>, - <c>test_server_ctrl:add_cases/2/3</c>.</p> - <p>Added test suite functions <c>init_per_suite/1</c> and - <c>end_per_suite/1</c>.</p> - <p><c>fin_per_testcase/2</c> is changed to - <c>end_per_testcase/2</c>. <c>fin_per_testcase</c> is kept - for backwards compatibility.</p> - <p>Added support for writing own test server frameworks. - Callback functions <c>init_tc/1</c>, <c>end_tc/3</c>, - <c>get_suite/2</c>, <c>report/2</c>, <c>warn/1</c>.</p> - </item> - </list> - </section> - </section> - - <section> - <title>Test Server 3.1</title> - - <section> - <title>Improvements and New Features</title> - <list type="bulleted"> - <item> - <p>Added the options <c>cover</c> and <c>cover_details</c> - to <c>ts:run</c>. When one of these options is used, - the tested application will be cover compiled - before the test is run. The cover compiled code will also - be loaded on all slave or peer nodes started with - <c>test_server:start_node</c>. When the test is completed - coverage data from all nodes is collected and merged, and - presented in the coverage log to which there will be a link - from the test suite result page (i.e. the one with the - heading "Test suite ... results").</p> - <p>The <c>cover_details</c> option will do - <c>cover:analyse_to_file</c> for each cover compiled module, - while the <c>cover</c> option only will produce a list of - modules and the number of covered/uncovered lines in each - module.</p> - <p>To make it possible to run all test from a script (like in - the OTP daily builds), the following is added: - <c>ts:run([all_tests | Options])</c>.</p> - <p>This means that e.g. the following is possible: - <c>erl -s ts run all_tests batch cover</c>.</p> - <p>Note that it is also possible to run tests with cover even - if you don't use <c>ts</c>. - See <c>test_server_ctrl:cover/2/3</c>.</p> - <p>Own Id: OTP-4703</p> - </item> - <item> - <p>Removed module <c>ts_save.erl</c> and function - <c>ts:save/0/1</c><em>(incompatible)</em>.</p> - <p>Added config variable <c>ipv6_hosts</c> to - <c>ts:install/1</c> and test spec file.</p> - <p>No longer removing duplicates of test cases from test spec - <em>(incompatible)</em>.</p> - <p>Added function <c>test_server:run_on_shielded_node/2</c>.</p> - <p>Creation of html files for test suite source does no longer - crash if suite contains more than 9999 lines of code.</p> - <p>Added functionality for cross cover compilation, - i.e. collection of cover data from all tests.</p> - <p>Multiplying timetrap times with 10 when running with cover.</p> - <p>Added <c>ts:r/3</c> for running tests with cover.</p> - <p>*** POTENTIAL INCOMPATIBILITY ***</p> - <p>Own Id: OTP-5040</p> - </item> - </list> - </section> - </section> -</chapter> - diff --git a/lib/test_server/doc/src/part.xml b/lib/test_server/doc/src/part.xml deleted file mode 100644 index 685ed16a94..0000000000 --- a/lib/test_server/doc/src/part.xml +++ /dev/null @@ -1,46 +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>2002</year><year>2013</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>Test Server User's Guide</title> - <prepared></prepared> - <docno></docno> - <date>2002-07-11</date> - <rev></rev> - </header> - <description> - <p><em>Test Server</em> is a portable test server for - automated application testing. The server can run test suites - and log progress and results to HTML - pages. The main purpose of Test Server is to act as engine - inside customized test tools. A callback interface for - such framework applications is provided.</p> - </description> - <xi:include href="basics_chapter.xml"/> - <xi:include href="test_spec_chapter.xml"/> - <xi:include href="write_test_chapter.xml"/> - <xi:include href="run_test_chapter.xml"/> - <xi:include href="write_framework_chapter.xml"/> - <xi:include href="example_chapter.xml"/> -</part> - diff --git a/lib/test_server/doc/src/part_notes.xml b/lib/test_server/doc/src/part_notes.xml deleted file mode 100644 index 8cb9b6c591..0000000000 --- a/lib/test_server/doc/src/part_notes.xml +++ /dev/null @@ -1,41 +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>2004</year><year>2013</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>Test Server Release Notes</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - </header> - <description> - <p>The <em>Test Server</em> is a portable test server for - application testing. The test server can run automatic test suites - and log progress and results to HTML - pages. It also provides some support for test suite authors.</p> - <p>For information about older versions, see - <url href="part_notes_history_frame.html">Release Notes History</url>.</p> - </description> - <xi:include href="notes.xml"/> -</part> - diff --git a/lib/test_server/doc/src/part_notes_history.xml b/lib/test_server/doc/src/part_notes_history.xml deleted file mode 100644 index 468b5aa8ba..0000000000 --- a/lib/test_server/doc/src/part_notes_history.xml +++ /dev/null @@ -1,39 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part> - <header> - <copyright> - <year>2006</year><year>2013</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>Test Server Release Notes History</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - </header> - <description> - <p>The <em>Test Server</em> is a portable test server for - application testing. The test server can run automatic test suites - and log progress and results to HTML - pages. It also provides some support for test suite authors.</p> - </description> - <include file="notes_history"></include> -</part> - diff --git a/lib/test_server/doc/src/ref_man.xml b/lib/test_server/doc/src/ref_man.xml deleted file mode 100644 index 1b06d9750b..0000000000 --- a/lib/test_server/doc/src/ref_man.xml +++ /dev/null @@ -1,44 +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>2013</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>Test Server Reference Manual</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - <file>ref_man.xml</file> - </header> - <description> - <p><em>Test Server</em> is a portable test server for - automated application testing. The server can run test suites - and log progress and results to HTML - pages. The main purpose of Test Server is to act as engine - inside customized test tools. A callback interface for - such framework applications is provided.</p> - </description> - <xi:include href="test_server_app.xml"/> - <xi:include href="test_server_ctrl.xml"/> - <xi:include href="test_server.xml"/> -</application> - diff --git a/lib/test_server/doc/src/run_test_chapter.xml b/lib/test_server/doc/src/run_test_chapter.xml deleted file mode 100644 index cb5b29c993..0000000000 --- a/lib/test_server/doc/src/run_test_chapter.xml +++ /dev/null @@ -1,50 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE chapter SYSTEM "chapter.dtd"> - -<chapter> - <header> - <copyright> - <year>2002</year><year>2013</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>Running Test Suites</title> - <prepared>Siri Hansen</prepared> - <docno></docno> - <date></date> - <rev></rev> - <file>run_test_chapter.xml</file> - </header> - - <section> - <title>Using the test server controller</title> - <p>The test server controller provides a low level interface to - all the Test Server functionality. It is possible to use this - interface directly, but it is recommended to use a framework - such as <em>Common Test</em> instead. If no existing framework - suits your needs, you could of course build your own - on top of the test server controller. Some information about how - to do this can be found in the section named "Writing you own - test server framework" in the Test Server User's Guide. - </p> - <p>For information about using the controller directly, please see - all available functions in the reference manual for - <c>test_server_ctrl</c>. - </p> - </section> -</chapter> - diff --git a/lib/test_server/doc/src/test_server.xml b/lib/test_server/doc/src/test_server.xml deleted file mode 100644 index 96ff6de3ba..0000000000 --- a/lib/test_server/doc/src/test_server.xml +++ /dev/null @@ -1,853 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE erlref SYSTEM "erlref.dtd"> - -<erlref> - <header> - <copyright> - <year>2007</year> - <year>2013</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. - - The Initial Developer of the Original Code is Ericsson AB. - </legalnotice> - - <title>test_server</title> - <prepared>Siri Hansen</prepared> - <responsible></responsible> - <docno></docno> - <approved></approved> - <checked></checked> - <date></date> - <rev></rev> - <file>test_server_ref.sgml</file> - </header> - <module>test_server</module> - <modulesummary>This module provides support for test suite authors.</modulesummary> - <description> - <p>The <c>test_server</c> module aids the test suite author by providing - various support functions. The supported functionality includes: - </p> - <list type="bulleted"> - <item>Logging and timestamping - </item> - <item>Capturing output to stdout - </item> - <item>Retrieving and flushing the message queue of a process - </item> - <item>Watchdog timers, process sleep, time measurement and unit - conversion - </item> - <item>Private scratch directory for all test suites - </item> - <item>Start and stop of slave- or peer nodes</item> - </list> - <p>For more information on how to write test cases and for - examples, please see the Test Server User's Guide. - </p> - </description> - - <section> - <title>TEST SUITE SUPPORT FUNCTIONS</title> - <p>The following functions are supposed to be used inside a test - suite. - </p> - </section> - <funcs> - <func> - <name>os_type() -> OSType</name> - <fsummary>Returns the OS type of the target node</fsummary> - <type> - <v>OSType = term()</v> - <d>This is the same as returned from <c>os:type/0</c></d> - </type> - <desc> - <p>This function is equivalent to <c>os:type/0</c>. It is kept - for backwards compatibility.</p> - </desc> - </func> - <func> - <name>fail()</name> - <name>fail(Reason)</name> - <fsummary>Makes the test case fail.</fsummary> - <type> - <v>Reason = term()</v> - <d>The reason why the test case failed.</d> - </type> - <desc> - <p>This will make the test suite fail with a given reason, or - with <c>suite_failed</c> if no reason was given. Use this - function if you want to terminate a test case, as this will - make it easier to read the log- and HTML files. <c>Reason</c> - will appear in the comment field in the HTML log.</p> - </desc> - </func> - <func> - <name>timetrap(Timout) -> Handle</name> - <fsummary></fsummary> - <type> - <v>Timeout = integer() | {hours,H} | {minutes,M} | {seconds,S}</v> - <v>H = M = S = integer()</v> - <v>Pid = pid()</v> - <d>The process that is to be timetrapped (<c>self()</c>by default)</d> - </type> - <desc> - <p>Sets up a time trap for the current process. An expired - timetrap kills the process with reason - <c>timetrap_timeout</c>. The returned handle is to be given - as argument to <c>timetrap_cancel</c> before the timetrap - expires. If <c>Timeout</c> is an integer, it is expected to - be milliseconds.</p> - <note> - <p>If the current process is trapping exits, it will not be killed - by the exit signal with reason <c>timetrap_timeout</c>. - If this happens, the process will be sent an exit signal - with reason <c>kill</c> 10 seconds later which will kill the - process. Information about the timetrap timeout will in - this case not be found in the test logs. However, the - error_logger will be sent a warning.</p> - </note> - </desc> - </func> - <func> - <name>timetrap_cancel(Handle) -> ok</name> - <fsummary>Cancels a timetrap.</fsummary> - <type> - <v>Handle = term()</v> - <d>Handle returned from <c>timetrap</c></d> - </type> - <desc> - <p>This function cancels a timetrap. This must be done before - the timetrap expires.</p> - </desc> - </func> - <func> - <name>timetrap_scale_factor() -> ScaleFactor</name> - <fsummary>Returns the scale factor for timeouts.</fsummary> - <type> - <v>ScaleFactor = integer()</v> - </type> - <desc> - <p>This function returns the scale factor by which all timetraps - are scaled. It is normally 1, but can be greater than 1 if - the test_server is running <c>cover</c>, using a larger amount of - scheduler threads than the amount of logical processors on the - system, running under purify, valgrind or in a debug-compiled - emulator. The scale factor can be used if you need to scale you - own timeouts in test cases with same factor as the test_server - uses.</p> - </desc> - </func> - <func> - <name>sleep(MSecs) -> ok</name> - <fsummary>Suspens the calling task for a specified time.</fsummary> - <type> - <v>MSecs = integer() | float() | infinity</v> - <d>The number of milliseconds to sleep</d> - </type> - <desc> - <p>This function suspends the calling process for at least the - supplied number of milliseconds. There are two major reasons - why you should use this function instead of - <c>timer:sleep</c>, the first being that the module - <c>timer</c> may be unavailable at the time the test suite is - run, and the second that it also accepts floating point - numbers.</p> - </desc> - </func> - <func> - <name>adjusted_sleep(MSecs) -> ok</name> - <fsummary>Suspens the calling task for a specified time.</fsummary> - <type> - <v>MSecs = integer() | float() | infinity</v> - <d>The default number of milliseconds to sleep</d> - </type> - <desc> - <p>This function suspends the calling process for at least the - supplied number of milliseconds. The function behaves the same - way as <c>test_server:sleep/1</c>, only <c>MSecs</c> - will be multiplied by the 'multiply_timetraps' value, if set, - and also automatically scaled up if 'scale_timetraps' is set - to true (which it is by default).</p> - </desc> - </func> - <func> - <name>hours(N) -> MSecs</name> - <name>minutes(N) -> MSecs</name> - <name>seconds(N) -> MSecs</name> - <fsummary></fsummary> - <type> - <v>N = integer()</v> - <d>Value to convert to milliseconds.</d> - </type> - <desc> - <p>Theese functions convert <c>N</c> number of hours, minutes - or seconds into milliseconds. - </p> - <p>Use this function when you want to - <c>test_server:sleep/1</c> for a number of seconds, minutes or - hours(!).</p> - </desc> - </func> - <func> - <name>format(Format) -> ok</name> - <name>format(Format, Args)</name> - <name>format(Pri, Format)</name> - <name>format(Pri, Format, Args)</name> - <fsummary></fsummary> - <type> - <v>Format = string()</v> - <d>Format as described for <c>io_:format</c>.</d> - <v>Args = list()</v> - <d>List of arguments to format.</d> - </type> - <desc> - <p>Formats output just like <c>io:format</c> but sends the - formatted string to a logfile. If the urgency value, - <c>Pri</c>, is lower than some threshold value, it will also - be written to the test person's console. Default urgency is - 50, default threshold for display on the console is 1. - </p> - <p>Typically, the test person don't want to see everything a - test suite outputs, but is merely interested in if the test - cases succeeded or not, which the test server tells him. If he - would like to see more, he could manually change the threshold - values by using the <c>test_server_ctrl:set_levels/3</c> - function.</p> - </desc> - </func> - <func> - <name>capture_start() -> ok</name> - <name>capture_stop() -> ok</name> - <name>capture_get() -> list()</name> - <fsummary>Captures all output to stdout for a process.</fsummary> - <desc> - <p>These functions makes it possible to capture all output to - stdout from a process started by the test suite. The list of - characters captured can be purged by using <c>capture_get</c>.</p> - </desc> - </func> - <func> - <name>messages_get() -> list()</name> - <fsummary>Empty the message queue.</fsummary> - <desc> - <p>This function will empty and return all the messages - currently in the calling process' message queue.</p> - </desc> - </func> - <func> - <name>timecall(M, F, A) -> {Time, Value}</name> - <fsummary>Measures the time needed to call a function.</fsummary> - <type> - <v>M = atom()</v> - <d>The name of the module where the function resides.</d> - <v>F = atom()</v> - <d>The name of the function to call in the module.</d> - <v>A = list()</v> - <d>The arguments to supply the called function.</d> - <v>Time = integer()</v> - <d>The number of seconds it took to call the function.</d> - <v>Value = term()</v> - <d>Value returned from the called function.</d> - </type> - <desc> - <p>This function measures the time (in seconds) it takes to - call a certain function. The function call is <em>not</em> - caught within a catch.</p> - </desc> - </func> - <func> - <name>do_times(N, M, F, A) -> ok</name> - <name>do_times(N, Fun)</name> - <fsummary>Calls MFA or Fun N times.</fsummary> - <type> - <v>N = integer()</v> - <d>Number of times to call MFA.</d> - <v>M = atom()</v> - <d>Module name where the function resides.</d> - <v>F = atom()</v> - <d>Function name to call.</d> - <v>A = list()</v> - <d>Arguments to M:F.</d> - </type> - <desc> - <p>Calls MFA or Fun N times. Useful for extensive testing of a - sensitive function.</p> - </desc> - </func> - <func> - <name>m_out_of_n(M, N, Fun) -> ok | exit({m_out_of_n_failed, {R,left_to_do}}</name> - <fsummary>Fault tolerant <c>do_times</c>.</fsummary> - <type> - <v>N = integer()</v> - <d>Number of times to call the Fun.</d> - <v>M = integer()</v> - <d>Number of times to require a successful return.</d> - </type> - <desc> - <p>Repeatedly evaluates the given function until it succeeds - (doesn't crash) M times. If, after N times, M successful - attempts have not been accomplished, the process crashes with - reason {m_out_of_n_failed, {R,left_to_do}}, where R indicates - how many cases that was still to be successfully completed. - </p> - <p>For example: - </p> - <p><c>m_out_of_n(1,4,fun() -> tricky_test_case() end)</c> <br></br> -Tries to run tricky_test_case() up to 4 times, and is - happy if it succeeds once. - </p> - <p><c>m_out_of_n(7,8,fun() -> clock_sanity_check() end)</c> <br></br> -Tries running clock_sanity_check() up to 8 times,and - allows the function to fail once. This might be useful if - clock_sanity_check/0 is known to fail if the clock crosses an - hour boundary during the test (and the up to 8 test runs could - never cross 2 boundaries)</p> - </desc> - </func> - <func> - <name>call_crash(M, F, A) -> Result</name> - <name>call_crash(Time, M, F, A) -> Result</name> - <name>call_crash(Time, Crash, M, F, A) -> Result</name> - <fsummary>Calls MFA and succeeds if it crashes.</fsummary> - <type> - <v>Result = ok | exit(call_crash_timeout) | exit({wrong_crash_reason, Reason})</v> - <v>Crash = term()</v> - <d>Crash return from the function.</d> - <v>Time = integer()</v> - <d>Timeout in milliseconds.</d> - <v>M = atom()</v> - <d>Module name where the function resides.</d> - <v>F = atom()</v> - <d>Function name to call.</d> - <v>A = list()</v> - <d>Arguments to M:F.</d> - </type> - <desc> - <p>Spawns a new process that calls MFA. The call is considered - successful if the call crashes with the gives reason - (<c>Crash</c>) or any reason if not specified. The call must - terminate within the given time (default <c>infinity</c>), or - it is considered a failure.</p> - </desc> - </func> - <func> - <name>temp_name(Stem) -> Name</name> - <fsummary>Returns a unique filename.</fsummary> - <type> - <v>Stem = string()</v> - </type> - <desc> - <p>Returns a unique filename starting with <c>Stem</c> with - enough extra characters appended to make up a unique - filename. The filename returned is guaranteed not to exist in - the filesystem at the time of the call.</p> - </desc> - </func> - <func> - <name>break(Comment) -> ok</name> - <fsummary>Cancel all timetraps and wait for call to continue/0.</fsummary> - <type> - <v>Comment = string()</v> - </type> - <desc> - <p><c>Comment</c> is a string which will be written in - the shell, e.g. explaining what to do.</p> - <p>This function will cancel all timetraps and pause the - execution of the test case until the user executes the - <c>continue/0</c> function. It gives the user the opportunity - to interact with the erlang node running the tests, e.g. for - debugging purposes or for manually executing a part of the - test case.</p> - <p>When the <c>break/1</c> function is called, the shell will - look something like this:</p> - <code type="none"><![CDATA[ - --- SEMIAUTOMATIC TESTING --- - The test case executes on process <0.51.0> - - - "Here is a comment, it could e.g. instruct to pull out a card" - - - ----------------------------- - - Continue with --> test_server:continue(). ]]></code> - <p>The user can now interact with the erlang node, and when - ready call <c>test_server:continue().</c></p> - <p>Note that this function can not be used if the test is - executed with <c>ts:run/0/1/2/3/4</c> in <c>batch</c> mode.</p> - </desc> - </func> - <func> - <name>continue() -> ok</name> - <fsummary>Continue after break/1.</fsummary> - <desc> - <p>This function must be called in order to continue after a - test case has called <c>break/1</c>.</p> - </desc> - </func> - <func> - <name>run_on_shielded_node(Fun, CArgs) -> term()</name> - <fsummary>Execute a function a shielded node.</fsummary> - <type> - <v>Fun = function() (arity 0)</v> - <d>Function to execute on the shielded node.</d> - <v>CArg = string()</v> - <d>Extra command line arguments to use when starting the shielded node.</d> - </type> - <desc> - <p><c>Fun</c> is executed in a process on a temporarily created - hidden node with a proxy for communication with the test server - node. The node is called a shielded node (should have been called - a shield node). If <c>Fun</c> is successfully executed, the result - is returned. A peer node (see <c>start_node/3</c>) started from - the shielded node will be shielded from test server node, i.e. - they will not be aware of each other. This is useful when you want - to start nodes from earlier OTP releases than the OTP release of - the test server node.</p> - <p>Nodes from an earlier OTP release can normally not be started - if the test server hasn't been started in compatibility mode - (see the <c>+R</c> flag in the <c>erl(1)</c> documentation) of - an earlier release. If a shielded node is started in compatibility - mode of an earlier OTP release than the OTP release of the test - server node, the shielded node can start nodes of an earlier OTP - release.</p> - <note> - <p>You <em>must</em> make sure that nodes started by the shielded - node never communicate directly with the test server node.</p> - </note> - <note> - <p>Slave nodes always communicate with the test server node; - therefore, <em>never</em> start <em>slave nodes</em> from the - shielded node, <em>always</em> start <em>peer nodes</em>.</p> - </note> - </desc> - </func> - <func> - <name>start_node(Name, Type, Options) -> {ok, Node} | {error, Reason}</name> - <fsummary>Start a node.</fsummary> - <type> - <v>Name = atom() | string()</v> - <d>Name of the slavenode to start (as given to -sname or -name)</d> - <v>Type = slave | peer</v> - <d>The type of node to start.</d> - <v>Options = [{atom(), term()]</v> - <d>Tuplelist of options</d> - </type> - <desc> - <p>This functions starts a node, possibly on a remote machine, - and guarantees cross architecture transparency. Type is set to - either <c>slave</c> or <c>peer</c>. - </p> - <p><c>slave</c> means that the new node will have a master, - i.e. the slave node will terminate if the master terminates, - TTY output produced on the slave will be sent back to the - master node and file I/O is done via the master. The master is - normally the target node unless the target is itself a slave. - </p> - <p><c>peer</c> means that the new node is an independent node - with no master. - </p> - <p><c>Options</c> is a tuplelist which can contain one or more - of - </p> - <taglist> - <tag><c>{remote, true}</c></tag> - <item>Start the node on a remote host. If not specified, the - node will be started on the local host. Test cases that - require a remote host will fail with a reasonable comment if - no remote hosts are available at the time they are run. - </item> - <tag><c>{args, Arguments}</c></tag> - <item>Arguments passed directly to the node. This is - typically a string appended to the command line. - </item> - <tag><c>{wait, false}</c></tag> - <item>Don't wait until the node is up. By default, this - function does not return until the node is up and running, - but this option makes it return as soon as the node start - command is given.. - <br></br> -Only valid for peer nodes - </item> - <tag><c>{fail_on_error, false}</c></tag> - <item>Returns <c>{error, Reason}</c> rather than failing the - test case. - <br></br> -Only valid for peer nodes. Note that slave nodes always - act as if they had <c>fail_on_error=false</c></item> - <tag><c>{erl, ReleaseList}</c></tag> - <item>Use an Erlang emulator determined by ReleaseList when - starting nodes, instead of the same emulator as the test - server is running. ReleaseList is a list of specifiers, - where a specifier is either {release, Rel}, {prog, Prog}, or - 'this'. Rel is either the name of a release, e.g., "r12b_patched" - or 'latest'. 'this' means using the same emulator as the test - server. Prog is the name of an emulator executable. If the - list has more than one element, one of them is picked - randomly. (Only works on Solaris and Linux, and the test server - gives warnings when it notices that nodes are not of the same - version as itself.) - <br></br> - <br></br> - - When specifying this option to run a previous release, use - <c>is_release_available/1</c> function to test if the given - release is available and skip the test case if not. - <br></br> - <br></br> - - In order to avoid compatibility problems (may not appear right - away), use a shielded node (see <c>run_on_shielded_node/2</c>) - when starting nodes from different OTP releases than the test - server. - </item> - <tag><c>{cleanup, false}</c></tag> - <item>Tells the test server not to kill this node if it is - still alive after the test case is completed. This is useful - if the same node is to be used by a group of test cases. - </item> - <tag><c>{env, Env}</c></tag> - <item><c>Env</c> should be a list of tuples <c>{Name, Val}</c>, - where <c>Name</c> is the name of an environment variable, and - <c>Val</c> is the value it is to have in the started node. - Both <c>Name</c> and <c>Val</c> must be strings. The one - exception is <c>Val</c> being the atom <c>false</c> (in - analogy with <c>os:getenv/1</c>), which removes the - environment variable. Only valid for peer nodes. Not - available on VxWorks.</item> - <tag><c>{start_cover, false}</c></tag> - <item>By default the test server will start cover on all nodes - when the test is run with code coverage analysis. To make - sure cover is not started on a new node, set this option to - <c>false</c>. This can be necessary if the connection to - the node at some point will be broken but the node is - expected to stay alive. The reason is that a remote cover - node can not continue to run without its main node. Another - solution would be to explicitly stop cover on the node - before breaking the connection, but in some situations (if - old code resides in one or more processes) this is not - possible.</item> - </taglist> - </desc> - </func> - <func> - <name>stop_node(NodeName) -> bool()</name> - <fsummary>Stops a node</fsummary> - <type> - <v>NodeName = term()</v> - <d>Name of the node to stop</d> - </type> - <desc> - <p>This functions stops a node previously started with - <c>start_node/3</c>. Use this function to stop any node you - start, or the test server will produce a warning message in - the test logs, and kill the nodes automatically unless it was - started with the <c>{cleanup, false}</c> option.</p> - </desc> - </func> - <func> - <name>is_commercial() -> bool()</name> - <fsummary>Tests whether the emulator is commercially supported</fsummary> - <desc> - <p>This function test whether the emulator is commercially supported - emulator. The tests for a commercially supported emulator could be more - stringent (for instance, a commercial release should always contain - documentation for all applications).</p> - </desc> - </func> - - <func> - <name>is_release_available(Release) -> bool()</name> - <fsummary>Tests whether a release is available</fsummary> - <type> - <v>Release = string() | atom()</v> - <d>Release to test for</d> - </type> - <desc> - <p>This function test whether the release given by - <c>Release</c> (for instance, "r12b_patched") is available - on the computer that the test_server controller is running on. - Typically, you should skip the test case if not.</p> - <p>Caution: This function may not be called from the <c>suite</c> - clause of a test case, as the test_server will deadlock.</p> - </desc> - </func> - <func> - <name>is_native(Mod) -> bool()</name> - <fsummary>Checks whether the module is natively compiled or not</fsummary> - <type> - <v>Mod = atom()</v> - <d>A module name</d> - </type> - <desc> - <p>Checks whether the module is natively compiled or not</p> - </desc> - </func> - <func> - <name>app_test(App) -> ok | test_server:fail()</name> - <name>app_test(App,Mode)</name> - <fsummary>Checks an applications .app file for obvious errors</fsummary> - <type> - <v>App = term()</v> - <d>The name of the application to test</d> - <v>Mode = pedantic | tolerant</v> - <d>Default is pedantic</d> - </type> - <desc> - <p>Checks an applications .app file for obvious errors. - The following is checked: - </p> - <list type="bulleted"> - <item>required fields - </item> - <item>that all modules specified actually exists - </item> - <item>that all requires applications exists - </item> - <item>that no module included in the application has export_all - </item> - <item>that all modules in the ebin/ dir is included (If - <c>Mode==tolerant</c> this only produces a warning, as all - modules does not have to be included)</item> - </list> - </desc> - </func> - <func> - <name>appup_test(App) -> ok | test_server:fail()</name> - <fsummary>Checks an applications .appup file for obvious errors</fsummary> - <type> - <v>App = term()</v> - <d>The name of the application to test</d> - </type> - <desc> - <p>Checks an applications .appup file for obvious errors. - The following is checked: - </p> - <list type="bulleted"> - <item>syntax - </item> - <item>that .app file version and .appup file version match - </item> - <item>for non-library applications: validity of high-level upgrade - instructions, specifying no instructions is explicitly allowed - (in this case the application is not upgradeable)</item> - <item>for library applications: that there is exactly one wildcard - regexp clause restarting the application when upgrading or - downgrading from any version</item> - </list> - </desc> - </func> - <func> - <name>comment(Comment) -> ok</name> - <fsummary>Print a comment on the HTML result page</fsummary> - <type> - <v>Comment = string()</v> - </type> - <desc> - <p>The given String will occur in the comment field of the - table on the HTML result page. If called several times, only - the last comment is printed. comment/1 is also overwritten by - the return value {comment,Comment} from a test case or by - fail/1 (which prints Reason as a comment).</p> - </desc> - </func> - </funcs> - - <section> - <title>TEST SUITE EXPORTS</title> - <p>The following functions must be exported from a test suite - module. - </p> - </section> - <funcs> - <func> - <name>all(suite) -> TestSpec | {skip, Comment}</name> - <fsummary>Returns the module's test specification</fsummary> - <type> - <v>TestSpec = list()</v> - <v>Comment = string()</v> - <d>This comment will be printed on the HTML result page</d> - </type> - <desc> - <p>This function must return the test specification for the - test suite module. The syntax of a test specification is - described in the Test Server User's Guide.</p> - </desc> - </func> - <func> - <name>init_per_suite(Config0) -> Config1 | {skip, Comment}</name> - <fsummary>Test suite initiation</fsummary> - <type> - <v>Config0 = Config1 = [tuple()]</v> - <v>Comment = string()</v> - <d>Describes why the suite is skipped</d> - </type> - <desc> - <p>This function is called before all other test cases in the - suite. <c>Config</c> is the configuration which can be modified - here. Whatever is returned from this function is given as - <c>Config</c> to the test cases. - </p> - <p>If this function fails, all test cases in the suite will be - skipped.</p> - </desc> - </func> - <func> - <name>end_per_suite(Config) -> void()</name> - <fsummary>Test suite finalization</fsummary> - <type> - <v>Config = [tuple()]</v> - </type> - <desc> - <p>This function is called after the last test case in the - suite, and can be used to clean up whatever the test cases - have done. The return value is ignored.</p> - </desc> - </func> - <func> - <name>init_per_testcase(Case, Config0) -> Config1 | {skip, Comment}</name> - <fsummary>Test case initiation</fsummary> - <type> - <v>Case = atom()</v> - <v>Config0 = Config1 = [tuple()]</v> - <v>Comment = string()</v> - <d>Describes why the test case is skipped</d> - </type> - <desc> - <p>This function is called before each test case. The - <c>Case</c> argument is the name of the test case, and - <c>Config</c> is the configuration which can be modified - here. Whatever is returned from this function is given as - <c>Config</c> to the test case.</p> - </desc> - </func> - <func> - <name>end_per_testcase(Case, Config) -> void()</name> - <fsummary>Test case finalization</fsummary> - <type> - <v>Case = atom()</v> - <v>Config = [tuple()]</v> - </type> - <desc> - <p>This function is called after each test case, and can be - used to clean up whatever the test case has done. The return - value is ignored.</p> - </desc> - </func> - <func> - <name>Case(doc) -> [Decription]</name> - <name>Case(suite) -> [] | TestSpec | {skip, Comment}</name> - <name>Case(Config) -> {skip, Comment} | {comment, Comment} | Ok</name> - <fsummary>A test case</fsummary> - <type> - <v>Description = string()</v> - <d>Short description of the test case</d> - <v>TestSpec = list()</v> - <v>Comment = string()</v> - <d>This comment will be printed on the HTML result page</d> - <v>Ok = term()</v> - <v>Config = [tuple()]</v> - <d>Elements from the Config parameter can be read with the ?config macro, see section about test suite support macros</d> - </type> - <desc> - <p>The <em>documentation clause</em> (argument <c>doc</c>) can - be used for automatic generation of test documentation or test - descriptions. - </p> - <p>The <em>specification clause</em> (argument <c>spec</c>) - shall return an empty list, the test specification for the - test case or <c>{skip,Comment}</c>. The syntax of a test - specification is described in the Test Server User's Guide. - </p> - <p>The <em>execution clause</em> (argument <c>Config</c>) is - only called if the specification clause returns an empty list. - The execution clause is the real test case. Here you must call - the functions you want to test, and do whatever you need to - check the result. If something fails, make sure the process - crashes or call <c>test_server:fail/0/1</c> (which also will - cause the process to crash). - </p> - <p>You can return <c>{skip,Comment}</c> if you decide not to - run the test case after all, e.g. if it is not applicable on - this platform. - </p> - <p>You can return <c>{comment,Comment}</c> if you wish to - print some information in the 'Comment' field on the HTML - result page. - </p> - <p>If the execution clause returns anything else, it is - considered a success, unless it is <c>{'EXIT',Reason}</c> or - <c>{'EXIT',Pid,Reason}</c> which can't be distinguished from a - crash, and thus will be considered a failure. - </p> - <p>A <em>conf test case</em> is a group of test cases with an - init and a cleanup function. The init and cleanup functions - are also test cases, but they have special rules:</p> - <list type="bulleted"> - <item>They do not need a specification clause.</item> - <item>They must always have the execution clause.</item> - <item>They must return the <c>Config</c> parameter, a modified - version of it or <c>{skip,Comment}</c> from the execution clause.</item> - <item>The cleanup function may also return a tuple - <c>{return_group_result,Status}</c>, which is used to return the - status of the conf case to Test Server and/or to a conf case on a - higher level. (<c>Status = ok | skipped | failed</c>).</item> - <item><c>init_per_testcase</c> and <c>end_per_testcase</c> are - not called before and after these functions.</item> - </list> - </desc> - </func> - </funcs> - - - <section> - <title>TEST SUITE SUPPORT MACROS</title> - <p>There are some macros defined in the <c>test_server.hrl</c> - that are quite useful for test suite programmers: - </p> - <p>The <em>config</em> macro, is used to - retrieve information from the <c>Config</c> variable sent to all - test cases. It is used with two arguments, where the first is the - name of the configuration variable you wish to retrieve, and the - second is the <c>Config</c> variable supplied to the test case - from the test server. - </p> - <p>Possible configuration variables include:</p> - <list type="bulleted"> - <item><c>data_dir</c> - Data file directory.</item> - <item><c>priv_dir</c> - Scratch file directory.</item> - <item><c>nodes</c> - Nodes specified in the spec file</item> - <item><c>nodenames</c> - Generated nodenames.</item> - <item>Whatever added by conf test cases or - <c>init_per_testcase/2</c></item> - </list> - <p>Examples of the <c>config</c> macro can be seen in the Examples chapter - in the user's guide.</p> - <p>The <em>line</em> and <em>line_trace</em> macros are deprecated, see - below.</p> - </section> - - <section> - <title>TEST SUITE LINE NUMBERS</title> - <p>In the past, ERTS did not produce line numbers when generating - stacktraces, test_server was thus unable to provide them when reporting - test failures. It had instead two different mecanisms to do it: either by - using the <c>line</c> macro or by using the <c>test_server_line</c> parse - transform. Both are deprecated and should not be used in new tests - anymore.</p> - </section> -</erlref> - diff --git a/lib/test_server/doc/src/test_server_app.xml b/lib/test_server/doc/src/test_server_app.xml deleted file mode 100644 index 4830916561..0000000000 --- a/lib/test_server/doc/src/test_server_app.xml +++ /dev/null @@ -1,75 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE appref SYSTEM "appref.dtd"> - -<appref> - <header> - <copyright> - <year>2002</year><year>2013</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>Test Server Application</title> - <prepared>Siri Hansen</prepared> - <responsible>Peter Andersson</responsible> - <docno></docno> - <approved></approved> - <checked></checked> - <date>2002-07-12</date> - <rev>PA1</rev> - <file>test_server_app.xml</file> - </header> - <app>test_server</app> - <appsummary>Test Server for manual or automatic testing of Erlang code</appsummary> - <description> - <p><em>Test Server</em> is a portable test server for - automated application testing. The server can run test suites - and log progress and results to HTML - pages. The main purpose of Test Server is to act as engine - inside customized test tools. A callback interface for - such framework applications is provided.</p> - <p>In brief the test server supports:</p> - <list type="bulleted"> - <item>Running multiple, concurrent test suites</item> - <item>Test suites may contain other test suites, in a tree fashion</item> - <item>Logging of the events in a test suite, on both suite and case levels</item> - <item>HTML presentation of test suite results</item> - <item>HTML presentation of test suite code</item> - <item>Support for test suite authors, e.g. start/stop slave nodes</item> - <item>Call trace on target and slave nodes</item> - </list> - <p>For information about how to write test cases and test suites, - please see the Test Server User's Guide and the reference - manual for the <c>test_server</c> module. - </p> - <p><em>Common Test</em> is an existing test tool application based on the - OTP Test Server. Please read the Common Test User's Guide for more information. - </p> - </description> - - <section> - <title>Configuration</title> - <p>There are currently no configuration parameters available for - this application. - </p> - </section> - - <section> - <title>SEE ALSO</title> - <p></p> - </section> -</appref> - diff --git a/lib/test_server/doc/src/test_server_ctrl.xml b/lib/test_server/doc/src/test_server_ctrl.xml deleted file mode 100644 index 2762997ece..0000000000 --- a/lib/test_server/doc/src/test_server_ctrl.xml +++ /dev/null @@ -1,844 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE erlref SYSTEM "erlref.dtd"> - -<erlref> - <header> - <copyright> - <year>2007</year> - <year>2013</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. - - The Initial Developer of the Original Code is Ericsson AB. - </legalnotice> - - <title>The Test Server Controller</title> - <prepared>Siri Hansen, Peter Andersson</prepared> - <responsible></responsible> - <docno></docno> - <approved></approved> - <checked></checked> - <date></date> - <rev></rev> - <file>test_server_ctrl_ref.sgml</file> - </header> - <module>test_server_ctrl</module> - <modulesummary>This module provides a low level interface to the Test Server.</modulesummary> - <description> - <p>The <c>test_server_ctrl</c> module provides a low level - interface to the Test Server. This interface is normally - not used directly by the tester, but through a framework built - on top of <c>test_server_ctrl</c>. - </p> - <p>Common Test is such a framework, well suited for automated - black box testing of target systems of any kind (not necessarily - implemented in Erlang). Common Test is also a very useful tool for - white box testing Erlang programs and OTP applications. - Please see the Common Test User's Guide and reference manual for - more information. - </p> - <p>If you want to write your own framework, some more information - can be found in the chapter "Writing your own test server - framework" in the Test Server User's Guide. Details about the - interface provided by <c>test_server_ctrl</c> follows below. - </p> - </description> - <funcs> - <func> - <name>start() -> Result</name> - <fsummary>Starts the test server.</fsummary> - <type> - <v>Result = ok | {error, {already_started, pid()}</v> - </type> - <desc> - <p>This function starts the test server.</p> - </desc> - </func> - <func> - <name>stop() -> ok</name> - <fsummary>Stops the test server immediately.</fsummary> - <desc> - <p>This stops the test server and - all its activity. The running test suite (if any) will be - halted.</p> - </desc> - </func> - <func> - <name>add_dir(Name, Dir) -> ok</name> - <name>add_dir(Name, Dir, Pattern) -> ok</name> - <name>add_dir(Name, [Dir|Dirs]) -> ok</name> - <name>add_dir(Name, [Dir|Dirs], Pattern) -> ok</name> - <fsummary>Add a directory to the job queue.</fsummary> - <type> - <v>Name = term()</v> - <d>The jobname for this directory.</d> - <v>Dir = term()</v> - <d>The directory to scan for test suites.</d> - <v>Dirs = [term()]</v> - <d>List of directories to scan for test suites.</d> - <v>Pattern = term()</v> - <d>Suite match pattern. Directories will be scanned for Pattern_SUITE.erl files.</d> - </type> - <desc> - <p>Puts a collection of suites matching (*_SUITE) in given - directories into the job queue. <c>Name</c> is an arbitrary - name for the job, it can be any erlang term. If <c>Pattern</c> - is given, only modules matching <c>Pattern*</c> will be added.</p> - </desc> - </func> - <func> - <name>add_module(Mod) -> ok</name> - <name>add_module(Name, [Mod|Mods]) -> ok</name> - <fsummary>Add a module to the job queue with or without a given name.</fsummary> - <type> - <v>Mod = atom()</v> - <v>Mods = [atom()]</v> - <d>The name(s) of the module(s) to add.</d> - <v>Name = term()</v> - <d>Name for the job.</d> - </type> - <desc> - <p>This function adds a module or a list of modules, to the - test servers job queue. <c>Name</c> may be any Erlang - term. When <c>Name</c> is not given, the job gets the name of - the module.</p> - </desc> - </func> - <func> - <name>add_case(Mod, Case) -> ok</name> - <fsummary>Adds one test case to the job queue.</fsummary> - <type> - <v>Mod = atom()</v> - <d>Name of the module the test case is in.</d> - <v>Case = atom() </v> - <d>Function name of the test case to add.</d> - </type> - <desc> - <p>This function will add one test case to the job queue. The - job will be given the module's name.</p> - </desc> - </func> - <func> - <name>add_case(Name, Mod, Case) -> ok</name> - <fsummary>Equivalent to add_case/2, but with specified name.</fsummary> - <type> - <v>Name = string()</v> - <d>Name to use for the test job.</d> - </type> - <desc> - <p>Equivalent to <c>add_case/2</c>, but the test job will get - the specified name.</p> - </desc> - </func> - <func> - <name>add_cases(Mod, Cases) -> ok</name> - <fsummary>Adds a list of test cases to the job queue.</fsummary> - <type> - <v>Mod = atom()</v> - <d>Name of the module the test case is in.</d> - <v>Cases = [Case] </v> - <v>Case = atom() </v> - <d>Function names of the test cases to add.</d> - </type> - <desc> - <p>This function will add one or more test cases to the job - queue. The job will be given the module's name.</p> - </desc> - </func> - <func> - <name>add_cases(Name, Mod, Cases) -> ok</name> - <fsummary>Equivalent to add_cases/2, but with specified name.</fsummary> - <type> - <v>Name = string()</v> - <d>Name to use for the test job.</d> - </type> - <desc> - <p>Equivalent to <c>add_cases/2</c>, but the test job will get - the specified name.</p> - </desc> - </func> - <func> - <name>add_spec(TestSpecFile) -> ok | {error, nofile}</name> - <fsummary>Adds a test specification file to the job queue.</fsummary> - <type> - <v>TestSpecFile = string()</v> - <d>Name of the test specification file</d> - </type> - <desc> - <p>This function will add the content of the given test - specification file to the job queue. The job will be given the - name of the test specification file, e.g. if the file is - called <c>test.spec</c>, the job will be called <c>test</c>. - </p> - <p>See the reference manual for the test server application - for details about the test specification file.</p> - </desc> - </func> - <func> - <name>add_dir_with_skip(Name, [Dir|Dirs], Skip) -> ok</name> - <name>add_dir_with_skip(Name, [Dir|Dirs], Pattern, Skip) -> ok</name> - <name>add_module_with_skip(Mod, Skip) -> ok</name> - <name>add_module_with_skip(Name, [Mod|Mods], Skip) -> ok</name> - <name>add_case_with_skip(Mod, Case, Skip) -> ok</name> - <name>add_case_with_skip(Name, Mod, Case, Skip) -> ok</name> - <name>add_cases_with_skip(Mod, Cases, Skip) -> ok</name> - <name>add_cases_with_skip(Name, Mod, Cases, Skip) -> ok</name> - <fsummary>Same purpose as functions listed above, but with extra Skip argument.</fsummary> - <type> - <v>Skip = [SkipItem]</v> - <d>List of items to be skipped from the test.</d> - <v>SkipItem = {Mod,Comment} | {Mod,Case,Comment} | {Mod,Cases,Comment}</v> - <v>Mod = atom()</v> - <d>Test suite name.</d> - <v>Comment = string()</v> - <d>Reason why suite or case is being skipped.</d> - <v>Cases = [Case]</v> - <v>Case = atom()</v> - <d>Name of test case function.</d> - </type> - <desc> - <p>These functions add test jobs just like the add_dir, add_module, - add_case and add_cases functions above, but carry an additional - argument, Skip. Skip is a list of items that should be skipped - in the current test run. Test job items that occur in the Skip - list will be logged as SKIPPED with the associated Comment.</p> - </desc> - </func> - <func> - <name>add_tests_with_skip(Name, Tests, Skip) -> ok</name> - <fsummary>Adds different types of jobs to the run queue.</fsummary> - <type> - <v>Name = term()</v> - <d>The jobname for this directory.</d> - <v>Tests = [TestItem]</v> - <d>List of jobs to add to the run queue.</d> - <v>TestItem = {Dir,all,all} | {Dir,Mods,all} | {Dir,Mod,Cases}</v> - <v>Dir = term()</v> - <d>The directory to scan for test suites.</d> - <v>Mods = [Mod]</v> - <v>Mod = atom()</v> - <d>Test suite name.</d> - <v>Cases = [Case]</v> - <v>Case = atom()</v> - <d>Name of test case function.</d> - <v>Skip = [SkipItem]</v> - <d>List of items to be skipped from the test.</d> - <v>SkipItem = {Mod,Comment} | {Mod,Case,Comment} | {Mod,Cases,Comment}</v> - <v>Comment = string()</v> - <d>Reason why suite or case is being skipped.</d> - </type> - <desc> - <p>This function adds various test jobs to the test_server_ctrl - job queue. These jobs can be of different type (all or specific suites - in one directory, all or specific cases in one suite, etc). It is also - possible to get particular items skipped by passing them along in the - Skip list (see the add_*_with_skip functions above).</p> - </desc> - </func> - <func> - <name>abort_current_testcase(Reason) -> ok | {error,no_testcase_running}</name> - <fsummary>Aborts the test case currently executing.</fsummary> - <type> - <v>Reason = term()</v> - <d>The reason for stopping the test case, which will be printed in the log.</d> - </type> - <desc> - <p>When calling this function, the currently executing test case will be aborted. - It is the user's responsibility to know for sure which test case is currently - executing. The function is therefore only safe to call from a function which - has been called (or synchronously invoked) by the test case.</p> - </desc> - </func> - <func> - <name>set_levels(Console, Major, Minor) -> ok</name> - <fsummary>Sets the levels of I/O.</fsummary> - <type> - <v>Console = integer()</v> - <d>Level for I/O to be sent to console.</d> - <v>Major = integer()</v> - <d>Level for I/O to be sent to the major logfile.</d> - <v>Minor = integer()</v> - <d>Level for I/O to be sent to the minor logfile.</d> - </type> - <desc> - <p>Determines where I/O from test suites/test server will - go. All text output from test suites and the test server is - tagged with a priority value which ranges from 0 to 100, 100 - being the most detailed. (see the section about log files in - the user's guide). Output from the test cases (using - <c>io:format/2</c>) has a detail level of 50. Depending on the - levels set by this function, this I/O may be sent to the - console, the major log file (for the whole test suite) or to - the minor logfile (separate for each test case). - </p> - <p>All output with detail level:</p> - <list type="bulleted"> - <item>Less than or equal to <c>Console</c> is displayed on - the screen (default 1) - </item> - <item>Less than or equal to <c>Major</c> is logged in the - major log file (default 19) - </item> - <item>Greater than or equal to <c>Minor</c> is logged in the - minor log files (default 10) - </item> - </list> - <p>To view the currently set thresholds, use the - <c>get_levels/0</c> function.</p> - </desc> - </func> - <func> - <name>get_levels() -> {Console, Major, Minor}</name> - <fsummary>Returns the current levels.</fsummary> - <desc> - <p>Returns the current levels. See <c>set_levels/3</c> for - types.</p> - </desc> - </func> - <func> - <name>jobs() -> JobQueue</name> - <fsummary>Returns the job queue.</fsummary> - <type> - <v>JobQueue = [{list(), pid()}]</v> - </type> - <desc> - <p>This function will return all the jobs currently in the job - queue.</p> - </desc> - </func> - <func> - <name>multiply_timetraps(N) -> ok</name> - <fsummary>All timetraps started after this will be multiplied by N.</fsummary> - <type> - <v>N = integer() | infinity</v> - </type> - <desc> - <p>This function should be called before a test is started - which requires extended timetraps, e.g. if extensive tracing - is used. All timetraps started after this call will be - multiplied by <c>N</c>.</p> - </desc> - </func> - <func> - <name>scale_timetraps(Bool) -> ok</name> - <fsummary>.</fsummary> - <type> - <v>Bool = true | false</v> - </type> - <desc> - <p>This function should be called before a test is started. - The parameter specifies if test_server should attempt - to automatically scale the timetrap value in order to compensate - for delays caused by e.g. the cover tool.</p> - </desc> - </func> - <func> - <name>get_timetrap_parameters() -> {N,Bool} </name> - <fsummary>Read the parameter values that affect timetraps.</fsummary> - <type> - <v>N = integer() | infinity</v> - <v>Bool = true | false</v> - </type> - <desc> - <p>This function may be called to read the values set by - <c>multiply_timetraps/1</c> and <c>scale_timetraps/1</c>.</p> - </desc> - </func> - <func> - <name>cover(Application,Analyse) -> ok</name> - <name>cover(CoverFile,Analyse) -> ok</name> - <name>cover(App,CoverFile,Analyse) -> ok</name> - <fsummary>Informs the test_server controller that next test shall run with code coverage analysis.</fsummary> - <type> - <v>Application = atom()</v> - <d>OTP application to cover compile</d> - <v>CoverFile = string()</v> - <d>Name of file listing modules to exclude from or include in cover compilation. The filename must include full path to the file.</d> - <v>Analyse = details | overview</v> - </type> - <desc> - <p>This function informs the test_server controller that next - test shall run with code coverage analysis. All timetraps will - automatically be multiplied by 10 when cover i run. - </p> - <p><c>Application</c> and <c>CoverFile</c> indicates what to - cover compile. If <c>Application</c> is given, the default is - that all modules in the <c>ebin</c> directory of the - application will be cover compiled. The <c>ebin</c> directory - is found by adding <c>ebin</c> to - <c>code:lib_dir(Application)</c>. - </p> - <p>A <c>CoverFile</c> can have the following entries:</p> - <code type="none"> -{exclude, all | ExcludeModuleList}. -{include, IncludeModuleList}. -{cross, CrossCoverInfo}.</code> - <p>Note that each line must end with a full - stop. <c>ExcludeModuleList</c> and <c>IncludeModuleList</c> - are lists of atoms, where each atom is a module name. - </p> - - <p><c>CrossCoverInfo</c> is used when collecting cover data - over multiple tests. Modules listed here are compiled, but - they will not be analysed when the test is finished. See - <seealso - marker="#cross_cover_analyse-2">cross_cover_analyse/2</seealso> - for more information about the cross cover mechanism and the - format of <c>CrossCoverInfo</c>. - </p> - <p>If both an <c>Application</c> and a <c>CoverFile</c> is - given, all modules in the application are cover compiled, - except for the modules listed in <c>ExcludeModuleList</c>. The - modules in <c>IncludeModuleList</c> are also cover compiled. - </p> - <p>If a <c>CoverFile</c> is given, but no <c>Application</c>, - only the modules in <c>IncludeModuleList</c> are cover - compiled. - </p> - <p><c>Analyse</c> indicates the detail level of the cover - analysis. If <c>Analyse = details</c>, each cover compiled - module will be analysed with - <c>cover:analyse_to_file/1</c>. If <c>Analyse = overview</c> - an overview of all cover compiled modules is created, listing - the number of covered and not covered lines for each module. - </p> - <p>If the test following this call starts any slave or peer - nodes with <c>test_server:start_node/3</c>, the same cover - compiled code will be loaded on all nodes. If the loading - fails, e.g. if the node runs an old version of OTP, the node - will simply not be a part of the coverage analysis. Note that - slave or peer nodes must be stopped with - <c>test_server:stop_node/1</c> for the node to be part of the - coverage analysis, else the test server will not be able to - fetch coverage data from the node. - </p> - <p>When the test is finished, the coverage analysis is - automatically completed, logs are created and the cover - compiled modules are unloaded. If another test is to be run - with coverage analysis, <c>test_server_ctrl:cover/2/3</c> must - be called again. - </p> - </desc> - </func> - <func> - <name>cross_cover_analyse(Level, Tests) -> ok</name> - <fsummary>Analyse cover data collected from multiple tests</fsummary> - <type> - <v>Level = details | overview</v> - <v>Tests = [{Tag,LogDir}]</v> - <v>Tag = atom()</v> - <d>Test identifier.</d> - <v>LogDir = string()</v> - <d>Log directory for the test identified by <c>Tag</c>. This - can either be the <c>run.<timestamp></c> directory or - the parent directory of this (in which case the latest - <c>run.<timestamp></c> directory is chosen.</d> - </type> - <desc> - <p>Analyse cover data collected from multiple tests. The modules - analysed are the ones listed in <c>cross</c> statements in - the cover files. These are modules that are heavily used by - other tests than the one where they belong or are explicitly - tested. They should then be listed as cross modules in the - cover file for the test where they are used but do not - belong. Se example below.</p> - <p>This function should be run after all tests are completed, - and the result will be stored in a file called - <c>cross_cover.html</c> in the <c>run.<timestamp></c> - directory of the test the modules belong to.</p> - <p>Note that the function can be executed on any node, and it - does not require <c>test_server_ctrl</c> to be started first.</p> - <p>The <c>cross</c> statement in the cover file must be like this:</p> - <code type="none"> -{cross,[{Tag,Modules}]}.</code> - <p>where <c>Tag</c> is the same as <c>Tag</c> in the - <c>Tests</c> parameter to this function and <c>Modules</c> is a - list of module names (atoms).</p> - <p><em>Example:</em></p> - <p>If the module <c>m1</c> belongs to system <c>s1</c> but is - heavily used also in the tests for another system <c>s2</c>, - then the cover files for the two systems' tests could be like - this:</p> -<code type="none"> -s1.cover: - {include,[m1]}. - -s2.cover: - {include,[....]}. % modules belonging to system s2 - {cross,[{s1,[m1]}]}.</code> - <p>When the tests for both <c>s1</c> and <c>s2</c> are completed, run</p> -<code type="none"> -test_server_ctrl:cross_cover_analyse(Level,[{s1,S1LogDir},{s2,S2LogDir}]) -</code> - - <p>and the accumulated cover data for <c>m1</c> will be written to - <c>S1LogDir/[run.<timestamp>/]cross_cover.html</c>.</p> - <p>Note that the <c>m1</c> module will also be presented in the - normal coverage log for <c>s1</c> (due to the include statement in - <c>s1.cover</c>), but that only includes the coverage achieved by the - <c>s1</c> test itself.</p> - <p>The Tag in the <c>cross</c> statement in the cover file has - no other purpose than mapping the list of modules - (<c>[m1]</c> in the example above) to the correct log - directory where it should be included in the - <c>cross_cover.html</c> file (<c>S1LogDir</c> in the example - above). I.e. the value of <c>Tag</c> has no meaning, it - could be <c>foo</c> as well as <c>s1</c> above, as long as - the same <c>Tag</c> is used in the cover file and in the - call to this function.</p> - </desc> - </func> - <func> - <name>trc(TraceInfoFile) -> ok | {error, Reason}</name> - <fsummary>Starts call trace on target and slave nodes</fsummary> - <type> - <v>TraceInfoFile = atom() | string()</v> - <d>Name of a file defining which functions to trace and how</d> - </type> - <desc> - <p>This function starts call trace on target and on slave or - peer nodes that are started or will be started by the test - suites. - </p> - <p>Timetraps are not extended automatically when tracing is - used. Use <c>multiply_timetraps/1</c> if necessary. - </p> - <p>Note that the trace support in the test server is in a very - early stage of the implementation, and thus not yet as - powerful as one might wish for. - </p> - <p>The trace information file specified by the - <c>TraceInfoFile</c> argument is a text file containing one or - more of the following elements: - </p> - <list type="bulleted"> - <item><c>{SetTP,Module,Pattern}.</c></item> - <item><c>{SetTP,Module,Function,Pattern}.</c></item> - <item><c>{SetTP,Module,Function,Arity,Pattern}.</c></item> - <item><c>ClearTP.</c></item> - <item><c>{ClearTP,Module}.</c></item> - <item><c>{ClearTP,Module,Function}.</c></item> - <item><c>{ClearTP,Module,Function,Arity}.</c></item> - </list> - <taglist> - <tag><c>SetTP = tp | tpl</c></tag> - <item>This is maps to the corresponding functions in the - <c>ttb</c> module in the <c>observer</c> - application. <c>tp</c> means set trace pattern on global - function calls. <c>tpl</c> means set trace pattern on local - and global function calls. - </item> - <tag><c>ClearTP = ctp | ctpl | ctpg</c></tag> - <item>This is maps to the corresponding functions in the - <c>ttb</c> module in the <c>observer</c> - application. <c>ctp</c> means clear trace pattern (i.e. turn - off) on global and local function calls. <c>ctpl</c> means - clear trace pattern on local function calls only and <c>ctpg</c> - means clear trace pattern on global function calls only. - </item> - <tag><c>Module = atom()</c></tag> - <item>The module to trace - </item> - <tag><c>Function = atom()</c></tag> - <item>The name of the function to trace - </item> - <tag><c>Arity = integer()</c></tag> - <item>The arity of the function to trace - </item> - <tag><c>Pattern = [] | match_spec()</c></tag> - <item>The trace pattern to set for the module or - function. For a description of the match_spec() syntax, - please turn to the User's guide for the runtime system - (erts). The chapter "Match Specification in Erlang" explains - the general match specification language. - </item> - </taglist> - <p>The trace result will be logged in a (binary) file called - <c>NodeName-test_server</c> in the current directory of the - test server controller node. The log must be formatted using - <c>ttb:format/1/2</c>. - </p> - </desc> - </func> - <func> - <name>stop_trace() -> ok | {error, not_tracing}</name> - <fsummary>Stops tracing on target and slave nodes.</fsummary> - <desc> - <p>This function stops tracing on target, and on slave or peer - nodes that are currently running. New slave or peer nodes will - no longer be traced after this.</p> - </desc> - </func> - </funcs> - - <section> - <title>FUNCTIONS INVOKED FROM COMMAND LINE</title> - <p>The following functions are supposed to be invoked from the - command line using the <c>-s</c> option when starting the erlang - node.</p> - </section> - <funcs> - <func> - <name>run_test(CommandLine) -> ok</name> - <fsummary>Runs the tests specified on the command line.</fsummary> - <type> - <v>CommandLine = FlagList</v> - </type> - <desc> - <p>This function is supposed to be invoked from the - commandline. It starts the test server, interprets the - argument supplied from the commandline, runs the tests - specified and when all tests are done, stops the test server - and returns to the Erlang prompt. - </p> - <p>The <c>CommandLine</c> argument is a list of command line - flags, typically <c>['KEY1', Value1, 'KEY2', Value2, ...]</c>. - The valid command line flags are listed below. - </p> - <p>Under a UNIX command prompt, this function can be invoked like this: - <br></br> -<c>erl -noshell -s test_server_ctrl run_test KEY1 Value1 KEY2 Value2 ... -s erlang halt</c></p> - <p>Or make an alias (this is for unix/tcsh) <br></br> -<c>alias erl_test 'erl -noshell -s test_server_ctrl run_test \!* -s erlang halt'</c></p> - <p>And then use it like this <br></br> -<c>erl_test KEY1 Value1 KEY2 Value2 ...</c> <br></br> -</p> - <p>The valid command line flags are</p> - <taglist> - <tag><c>DIR dir</c></tag> - <item>Adds all test modules in the directory <c>dir</c> to - the job queue. - </item> - <tag><c>MODULE mod</c></tag> - <item>Adds the module <c>mod</c> to the job queue. - </item> - <tag><c>CASE mod case</c></tag> - <item>Adds the case <c>case</c> in module <c>mod</c> to the - job queue. - </item> - <tag><c>SPEC spec</c></tag> - <item>Runs the test specification file <c>spec</c>. - </item> - <tag><c>SKIPMOD mod</c></tag> - <item>Skips all test cases in the module <c>mod</c></item> - <tag><c>SKIPCASE mod case</c></tag> - <item>Skips the test case <c>case</c> in module <c>mod</c>. - </item> - <tag><c>NAME name</c></tag> - <item>Names the test suite to something else than the - default name. This does not apply to <c>SPEC</c> which keeps - its names. - </item> - <tag><c>COVER app cover_file analyse</c></tag> - <item>Indicates that the test should be run with cover - analysis. <c>app</c>, <c>cover_file</c> and <c>analyse</c> - corresponds to the parameters to - <c>test_server_ctrl:cover/3</c>. If no cover file is used, - the atom <c>none</c> should be given. - </item> - <tag><c>TRACE traceinfofile</c></tag> - <item>Specifies a trace information file. When this option - is given, call tracing is started on the target node and all - slave or peer nodes that are started. The trace information - file specifies which modules and functions to trace. See the - function <c>trc/1</c> above for more information about the - syntax of this file. - </item> - </taglist> - </desc> - </func> - </funcs> - - <section> - <title>FRAMEWORK CALLBACK FUNCTIONS</title> - <p>A test server framework can be defined by setting the - environment variable <c>TEST_SERVER_FRAMEWORK</c> to a module - name. This module will then be framework callback module, and it - must export the following function:</p> - </section> - <funcs> - <func> - <name>get_suite(Mod,Func) -> TestCaseList</name> - <fsummary>Get subcases.</fsummary> - <type> - <v>Mod = atom()</v> - <d>Test suite name.</d> - <v>Func = atom()</v> - <d>Name of test case.</d> - <v>TestCaseList = [SubCase]</v> - <d>List of test cases.</d> - <v>SubCase = atom()</v> - <d>Name of a case.</d> - </type> - <desc> - <p>This function is called before a test case is started. The - purpose is to retrieve a list of subcases. The default - behaviour of this function should be to call - <c>Mod:Func(suite)</c> and return the result from this call.</p> - </desc> - </func> - <func> - <name>init_tc(Mod,Func,Args0) -> {ok,Args1} | {skip,ReasonToSkip} | {auto_skip,ReasonToSkip} | {fail,ReasonToFail}</name> - <fsummary>Preparation for a test case or configuration function.</fsummary> - <type> - <v>Mod = atom()</v> - <d>Test suite name.</d> - <v>Func = atom()</v> - <d>Name of test case or configuration function.</d> - <v>Args0 = Args1 = [tuple()]</v> - <d>Normally Args = [Config]</d> - <v>ReasonToSkip = term()</v> - <d>Reason to skip the test case or configuration function.</d> - <v>ReasonToFail = term()</v> - <d>Reason to fail the test case or configuration function.</d> - </type> - <desc> - <p>This function is called before a test case or configuration - function starts. It is called on the process executing the function - <c>Mod:Func</c>. Typical use of this function can be to alter - the input parameters to the test case function (<c>Args</c>) or - to set properties for the executing process.</p> - <p>By returning <c>{skip,Reason}</c>, <c>Func</c> gets skipped. - <c>Func</c> also gets skipped if <c>{auto_skip,Reason}</c> is returned, - but then gets an auto skipped status (rather than user skipped).</p> - <p>To fail <c>Func</c> immediately instead of executing it, return - <c>{fail,ReasonToFail}.</c></p> - </desc> - </func> - <func> - <name>end_tc(Mod,Func,Status) -> ok | {fail,ReasonToFail}</name> - <fsummary>Cleanup after a test case or configuration function.</fsummary> - <type> - <v>Mod = atom()</v> - <d>Test suite name.</d> - <v>Func = atom()</v> - <d>Name of test case or configuration function.</d> - <v>Status = {Result,Args} | {TCPid,Result,Args}</v> - <d>The status of the test case or configuration function.</d> - <v>ReasonToFail = term()</v> - <d>Reason to fail the test case or configuration function.</d> - <v>Result = ok | Skip | Fail</v> - <d>The final result of the test case or configuration function.</d> - <v>TCPid = pid()</v> - <d>Pid of the process executing Func</d> - <v>Skip = {skip,SkipReason}</v> - <v>SkipReason = term() | {failed,{Mod,init_per_testcase,term()}}</v> - <d>Reason why the function was skipped.</d> - <v>Fail = {error,term()} | {'EXIT',term()} | {timetrap_timeout,integer()} | - {testcase_aborted,term()} | testcase_aborted_or_killed | - {failed,term()} | {failed,{Mod,end_per_testcase,term()}}</v> - <d>Reason why the function failed.</d> - <v>Args = [tuple()]</v> - <d>Normally Args = [Config]</d> - </type> - <desc> - <p>This function is called when a test case, or a configuration function, - is finished. It is normally called on the process where the function - <c>Mod:Func</c> has been executing, but if not, the pid of the test - case process is passed with the <c>Status</c> argument.</p> - <p>Typical use of the <c>end_tc/3</c> function can be to clean up - after <c>init_tc/3</c>.</p> - <p>If <c>Func</c> is a test case, it is possible to analyse the value of - <c>Result</c> to verify that <c>init_per_testcase/2</c> and - <c>end_per_testcase/2</c> executed successfully.</p> - <p>It is possible with <c>end_tc/3</c> to fail an otherwise successful - test case, by returning <c>{fail,ReasonToFail}</c>. The test case <c>Func</c> - will be logged as failed with the provided term as reason.</p> - </desc> - </func> - <func> - <name>report(What,Data) -> ok</name> - <fsummary>Progress report for test.</fsummary> - <type> - <v>What = atom()</v> - <v>Data = term()</v> - </type> - <desc> - <p>This function is called in order to keep the framework up-to-date with - the progress of the test. This is useful e.g. if the - framework implements a GUI where the progress information is - constantly updated. The following can be reported: - </p> - <p><c>What = tests_start, Data = {Name,NumCases}</c><br></br> - <c>What = loginfo, Data = [{topdir,TestRootDir},{rundir,CurrLogDir}]</c><br></br> - <c>What = tests_done, Data = {Ok,Failed,{UserSkipped,AutoSkipped}}</c><br></br> - <c>What = tc_start, Data = {{Mod,{Func,GroupName}},TCLogFile}</c><br></br> - <c>What = tc_done, Data = {Mod,{Func,GroupName},Result}</c><br></br> - <c>What = tc_user_skip, Data = {Mod,{Func,GroupName},Comment}</c><br></br> - <c>What = tc_auto_skip, Data = {Mod,{Func,GroupName},Comment}</c><br></br> - <c>What = framework_error, Data = {{FWMod,FWFunc},Error}</c></p> - <p>Note that for a test case function that doesn't belong to a group, - <c>GroupName</c> has value <c>undefined</c>, otherwise the name of the test - case group.</p> - </desc> - </func> - <func> - <name>error_notification(Mod, Func, Args, Error) -> ok</name> - <fsummary>Inform framework of crashing testcase or configuration function.</fsummary> - <type> - <v>Mod = atom()</v> - <d>Test suite name.</d> - <v>Func = atom()</v> - <d>Name of test case or configuration function.</d> - <v>Args = [tuple()]</v> - <d>Normally Args = [Config]</d> - <v>Error = {Reason,Location}</v> - <v>Reason = term()</v> - <d>Reason for termination.</d> - <v>Location = unknown | [{Mod,Func,Line}]</v> - <d>Last known position in Mod before termination.</d> - <v>Line = integer()</v> - <d>Line number in file Mod.erl.</d> - </type> - <desc> - <p>This function is called as the result of function <c>Mod:Func</c> failing - with Reason at Location. The function is intended mainly to aid - specific logging or error handling in the framework application. Note - that for Location to have relevant values (i.e. other than unknown), - the <c>line</c> macro or <c>test_server_line</c> parse transform must - be used. For details, please see the section about test suite line numbers - in the <c>test_server</c> reference manual page.</p> - </desc> - </func> - <func> - <name>warn(What) -> boolean()</name> - <fsummary>Ask framework if test server should issue a warning for What.</fsummary> - <type> - <v>What = processes | nodes</v> - </type> - <desc> - <p>The test server checks the number of processes and nodes - before and after the test is executed. This function is a - question to the framework if the test server should warn when - the number of processes or nodes has changed during the test - execution. If <c>true</c> is returned, a warning will be written - in the test case minor log file.</p> - </desc> - </func> - <func> - <name>target_info() -> InfoStr</name> - <fsummary>Print info about the target system to the test case log.</fsummary> - <type> - <v>InfoStr = string() | ""</v> - </type> - <desc> - <p>The test server will ask the framework for information about - the test target system and print InfoStr in the test case - log file below the host information.</p> - </desc> - </func> - </funcs> -</erlref> - diff --git a/lib/test_server/doc/src/test_spec_chapter.xml b/lib/test_server/doc/src/test_spec_chapter.xml deleted file mode 100644 index 0a62010364..0000000000 --- a/lib/test_server/doc/src/test_spec_chapter.xml +++ /dev/null @@ -1,375 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE chapter SYSTEM "chapter.dtd"> - -<chapter> - <header> - <copyright> - <year>2002</year><year>2013</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>Test Structure and Test Specifications</title> - <prepared>Siri Hansen</prepared> - <docno></docno> - <date></date> - <rev></rev> - <file>test_spec_chapter.xml</file> - </header> - - <section> - <title>Test structure</title> - <p>A test consists of a set of test cases. Each test case is - implemented as an erlang function. An erlang module implementing - one or more test cases is called a test suite. - </p> - </section> - - <section> - <title>Test specifications</title> - <p>A test specification is a specification of which test suites - and test cases to run and which to skip. A test specification can - also group several test cases into conf cases with init and - cleanup functions (see section about configuration cases - below). In a test there can be test specifications on three - different levels: - </p> - <p>The top level is a test specification file which roughly - specifies what to test for a whole application. The test - specification in such a file is encapsulated in a topcase - command. - </p> - <p>Then there is a test specification for each test suite, - specifying which test cases to run within the suite. The test - specification for a test suite is returned from the - <c>all(suite)</c> function in the test suite module. - </p> - <p>And finally there can be a test specification per test case, - specifying sub test cases to run. The test specification for a - test case is returned from the specification clause of the test - case. - </p> - <p>When a test starts, the total test specification is built in a - tree fashion, starting from the top level test specification. - </p> - <p>The following are the valid elements of a test - specification. The specification can be one of these elements or a - list with any combination of the elements: - </p> - <taglist> - <tag><c>{Mod, Case}</c></tag> - <item>This specifies the test case Mod:Case/1 - </item> - <tag><c>{dir, Dir}</c></tag> - <item>This specifies all modules <c>*_SUITE</c> in the directory - <c>Dir</c></item> - <tag><c>{dir, Dir, Pattern}</c></tag> - <item>This specifies all modules <c>Pattern*</c> in the - directory <c>Dir</c></item> - <tag><c>{conf, Init, TestSpec, Fin}</c></tag> - <item>This is a configuration case. In a test specification - file, <c>Init</c> and <c>Fin</c> must be - <c>{Mod,Func}</c>. Inside a module they can also be just - <c>Func</c>. See the section named Configuration Cases below for - more information about this. - </item> - <tag><c>{conf, Properties, Init, TestSpec, Fin}</c></tag> - <item>This is a configuration case as explained above, but - which also takes a list of execution properties for its group - of test cases and nested sub-groups. - </item> - <tag><c>{make, Init, TestSpec, Fin}</c></tag> - <item>This is a special version of a conf case which is only - used by the test server framework <c>ts</c>. <c>Init</c> and - <c>Fin</c> are make and unmake functions for a data - directory. <c>TestSpec</c> is the test specification for the - test suite owning the data directory in question. If the make - function fails, all tests in the test suite are skipped. The - difference between this "make case" and a normal conf case is - that for the make case, <c>Init</c> and <c>Fin</c> are given with - arguments (<c>{Mod,Func,Args}</c>). - </item> - <tag><c>Case</c></tag> - <item>This can only be used inside a module, i.e. not a test - specification file. It specifies the test case - <c>CurrentModule:Case</c>. - </item> - </taglist> - </section> - - <section> - <title>Test Specification Files</title> - <p>A test specification file is a text file containing the top - level test specification (a topcase command), and possibly one or - more additional commands. A "command" in a test specification file - means a key-value tuple ended by a dot-newline sequence. - </p> - <p>The following commands are valid: - </p> - <taglist> - <tag><c>{topcase, TestSpec}</c></tag> - <item>This command is mandatory in all test specification - files. <c>TestSpec</c> is the top level test specification of a - test. - </item> - <tag><c>{skip, {Mod, Comment}}</c></tag> - <item>This specifies that all cases in the module <c>Mod</c> - shall be skipped. <c>Comment</c> is a string. - </item> - <tag><c>{skip, {Mod, Case, Comment}}</c></tag> - <item>This specifies that the case <c>Mod:Case</c> shall be - skipped. - </item> - <tag><c>{skip, {Mod, CaseList, Comment}}</c></tag> - <item>This specifies that all cases <c>Mod:Case</c>, where - <c>Case</c> is in <c>CaseList</c>, shall be skipped. - </item> - <tag><c>{nodes, Nodes}</c></tag> - <item><c>Nodes</c> is a list of nodenames available to the test - suite. It will be added to the <c>Config</c> argument to all - test cases. <c>Nodes</c> is a list of atoms. - </item> - <tag><c>{require_nodenames, Num}</c></tag> - <item>Specifies how many nodenames the test suite will - need. Theese will be automatically generated and inserted into the - <c>Config</c> argument to all test cases. <c>Num</c> is an - integer. - </item> - <tag><c>{hosts, Hosts}</c></tag> - <item>This is a list of available hosts on which to start slave - nodes. It is used when the <c>{remote, true}</c> option is given - to the <c>test_server:start_node/3</c> function. Also, if - <c>{require_nodenames, Num}</c> is contained in a test - specification file, the generated nodenames will be spread over - all hosts given in this <c>Hosts</c> list. The hostnames are - atoms or strings. - </item> - <tag><c>{diskless, true}</c></tag> - <item>Adds <c>{diskless, true}</c> to the <c>Config</c> argument - to all test cases. This is kept for backwards compatibility and - should not be used. Use a configuration case instead. - </item> - <tag><c>{ipv6_hosts, Hosts}</c></tag> - <item>Adds <c>{ipv6_hosts, Hosts}</c> to the <c>Config</c> - argument to all test cases.</item> - </taglist> - <p>All test specification files shall have the extension - ".spec". If special test specification files are needed for - Windows or VxWorks platforms, additional files with the - extension ".spec.win" and ".spec.vxworks" shall be - used. This is useful e.g. if some test cases shall be skipped on - these platforms. - </p> - <p>Some examples for test specification files can be found in the - Examples section of this user's guide. - </p> - </section> - - <section> - <title>Configuration cases</title> - <p>If a group of test cases need the same initialization, a so called - <em>configuration</em> or <em>conf</em> case can be used. A conf - case consists of an initialization function, the group of test cases - needing this initialization and a cleanup or finalization function. - </p> - <p>If the init function in a conf case fails or returns - <c>{skip,Comment}</c>, the rest of the test cases in the conf case - (including the cleanup function) are skipped. If the init function - succeeds, the cleanup function will always be called, even if some - of the test cases in between failed. - </p> - <p>Both the init function and the cleanup function in a conf case - get the <c>Config</c> parameter as only argument. This parameter - can be modified or returned as is. Whatever is returned by the - init function is given as <c>Config</c> parameter to the rest of - the test cases in the conf case, including the cleanup function. - </p> - <p>If the <c>Config</c> parameter is changed by the init function, - it must be restored by the cleanup function. Whatever is returned - by the cleanup function will be given to the next test case called. - </p> - <p>The optional <c>Properties</c> list can be used to specify - execution properties for the test cases and possibly nested - sub-groups of the configuration case. The available properties are:</p> - <pre> - Properties = [parallel | sequence | Shuffle | {RepeatType,N}] - Shuffle = shuffle | {shuffle,Seed} - Seed = {integer(),integer(),integer()} - RepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail | - repeat_until_any_ok | repeat_until_any_fail - N = integer() | forever</pre> - - <p>If the <c>parallel</c> property is specified, Test Server will execute - all test cases in the group in parallel. If <c>sequence</c> is specified, - the cases will be executed in a sequence, meaning if one case fails, all - following cases will be skipped. If <c>shuffle</c> is specified, the cases - in the group will be executed in random order. The <c>repeat</c> property - orders Test Server to repeat execution of the cases in the group a given - number of times, or until any, or all, cases fail or succeed.</p> - - <p>Properties may be combined so that e.g. if <c>shuffle</c>, - <c>repeat_until_any_fail</c> and <c>sequence</c> are all specified, the test - cases in the group will be executed repeatedly and in random order until - a test case fails, when execution is immediately stopped and the rest of - the cases skipped.</p> - - <p>The properties for a conf case is always printed on the top of the HTML log - for the group's init function. Also, the total execution time for a conf case - can be found at the bottom of the log for the group's end function.</p> - - <p>Configuration cases may be nested so that sets of grouped cases can be - configured with the same init- and end functions.</p> - </section> - - <section> - <title>The parallel property and nested configuration cases</title> - <p>If a conf case has a parallel property, its test cases will be spawned - simultaneously and get executed in parallel. A test case is not allowed - to execute in parallel with the end function however, which means - that the time it takes to execute a set of parallel cases is equal to the - execution time of the slowest test case in the group. A negative side - effect of running test cases in parallel is that the HTML summary pages - are not updated with links to the individual test case logs until the - end function for the conf case has finished.</p> - - <p>A conf case nested under a parallel conf case will start executing in - parallel with previous (parallel) test cases (no matter what properties the - nested conf case has). Since, however, test cases are never executed in - parallel with the init- or the end function of the same conf case, it's - only after a nested group of cases has finished that any remaining parallel - cases in the previous conf case get spawned.</p> - </section> - - <section> - <title>Repeated execution of test cases</title> - <marker id="repeated_cases"></marker> - <p>A conf case may be repeated a certain number of times - (specified by an integer) or indefinitely (specified by <c>forever</c>). - The repetition may also be stopped prematurely if any or all cases - fail or succeed, i.e. if the property <c>repeat_until_any_fail</c>, - <c>repeat_until_any_ok</c>, <c>repeat_until_all_fail</c>, or - <c>repeat_until_all_ok</c> is used. If the basic <c>repeat</c> - property is used, status of test cases is irrelevant for the repeat - operation.</p> - - <p>It is possible to return the status of a conf case (ok or - failed), to affect the execution of the conf case on the level above. - This is accomplished by, in the end function, looking up the value - of <c>tc_group_properties</c> in the <c>Config</c> list and checking the - result of the finished test cases. If status <c>failed</c> should be - returned from the conf case as a result, the end function should return - the value <c>{return_group_result,failed}</c>. The status of a nested conf - case is taken into account by Test Server when deciding if execution - should be repeated or not (unless the basic <c>repeat</c> property is used).</p> - - <p>The <c>tc_group_properties</c> value is a list of status tuples, - each with the key <c>ok</c>, <c>skipped</c> and <c>failed</c>. The - value of a status tuple is a list containing names of test cases - that have been executed with the corresponding status as result.</p> - - <p>Here's an example of how to return the status from a conf case:</p> - <pre> - conf_end_function(Config) -> - Status = ?config(tc_group_result, Config), - case proplists:get_value(failed, Status) of - [] -> % no failed cases - {return_group_result,ok}; - _Failed -> % one or more failed - {return_group_result,failed} - end.</pre> - - <p>It is also possible in the end function to check the status of - a nested conf case (maybe to determine what status the current conf case should - return). This is as simple as illustrated in the example above, only the - name of the end function of the nested conf case is stored in a tuple - <c>{group_result,EndFunc}</c>, which can be searched for in the status lists. - Example:</p> - <pre> - conf_end_function_X(Config) -> - Status = ?config(tc_group_result, Config), - Failed = proplists:get_value(failed, Status), - case lists:member({group_result,conf_end_function_Y}, Failed) of - true -> - {return_group_result,failed}; - false -> - {return_group_result,ok} - end; - ...</pre> - - <note><p>When a conf case is repeated, the init- and end functions - are also always called with each repetition.</p></note> - </section> - - <section> - <title>Shuffled test case order</title> - <p>The order that test cases in a conf case are executed, is under normal - circumstances the same as the order defined in the test specification. - With the <c>shuffle</c> property set, however, Test Server will instead - execute the test cases in random order.</p> - - <p>The user may provide a seed value (a tuple of three integers) with - the shuffle property: <c>{shuffle,Seed}</c>. This way, the same shuffling - order can be created every time the conf case is executed. If no seed value - is given, Test Server creates a "random" seed for the shuffling operation - (using the return value of <c>erlang:now()</c>). The seed value is always - printed to the log file of the init function so that it can be used to - recreate the same execution order in subsequent test runs.</p> - - <note><p>If execution of a conf case with shuffled test cases is repeated, - the seed will not be reset in between turns.</p></note> - - <p>If a nested conf case is specified in a conf case with a <c>shuffle</c> - property, the execution order of the nested cases in relation to the test cases - (and other conf cases) is also random. The order of the test cases in the nested - conf case is however not random (unless, of course, this one also has a - <c>shuffle</c> property).</p> - </section> - - <section> - <title>Skipping test cases</title> - <p>It is possible to skip certain test cases, for example if you - know beforehand that a specific test case fails. This might be - functionality which isn't yet implemented, a bug that is known but - not yet fixed or some functionality which doesn't work or isn't - applicable on a specific platform. - </p> - <p>There are several different ways to state that a test case - should be skipped:</p> - <list type="bulleted"> - <item>Using the <c>{skip,What}</c> command in a test - specification file - </item> - <item>Returning <c>{skip,Reason}</c> from the - <c>init_per_testcase/2</c> function - </item> - <item>Returning <c>{skip,Reason}</c> from the specification - clause of the test case - </item> - <item>Returning <c>{skip,Reason}</c> from the execution clause - of the test case - </item> - </list> - <p>The latter of course means that the execution clause is - actually called, so the author must make sure that the test case - is not run. For more information about the different clauses in a - test case, see the chapter about writing test cases. - </p> - <p>When a test case is skipped, it will be noted as <c>SKIPPED</c> - in the HTML log. - </p> - </section> -</chapter> - diff --git a/lib/test_server/doc/src/ts.xml b/lib/test_server/doc/src/ts.xml deleted file mode 100644 index 60dfdbc545..0000000000 --- a/lib/test_server/doc/src/ts.xml +++ /dev/null @@ -1,568 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE erlref SYSTEM "erlref.dtd"> - -<erlref> - <header> - <copyright> - <year>2007</year> - <year>2013</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. - - The Initial Developer of the Original Code is Ericsson AB. - </legalnotice> - - <title>The OTP Test Server Framework</title> - <prepared>Mattias Nilsson</prepared> - <responsible></responsible> - <docno></docno> - <approved></approved> - <checked></checked> - <date></date> - <rev></rev> - <file>ts.xml</file> - </header> - <module>ts</module> - <modulesummary>Test Server Framework for testing OTP</modulesummary> - <description> - <p>This is a framework for testing OTP. The <c>ts</c> module - implements the interface to all the functionality in the - framework. - </p> - <p>The framework is built on top of the Test Server Controller, - <c>test_server_ctrl</c>, and provides a high level operator - interface. The main features added by the framework are: - </p> - <list type="bulleted"> - <item>Automatic compilation of test suites and data directories - </item> - <item>Collection of files in central directories and creation of - additional HTML pages for better overview. - </item> - <item>Single command interface for running all available tests - </item> - <item>Spawns a new node with correct parameters before starting - the test server - </item> - <item>Atomatically creates the parameter file needed when - running tests on remote target - </item> - </list> - <p>More information about the Test Server Framework and how to run - test cases can be found in the Test Server User's Guide. - </p> - <p>For writing you own test server framework, please turn to the - reference manual for the Test Server Controller and chapter named - "Writing your own test server framework" in the Test Server User's - Guide. - </p> - <p>SETUP</p> - <p>To be able to run <c>ts</c>, you must first `install' - <c>ts</c> for the current environment. This is done by calling - <c>ts:install/0/1/2</c>. A file called `variables' is created - and used by <c>ts</c> when running test suites. It is not - recommended to edit this file, but it is possible to alter if - <c>ts</c> gets the wrong idea about your environment. - </p> - <p><c>ts:install/0</c> is used if the target platform is the - same as the controller host, i.e. if you run on "local target" - and no options are needed. Then running <c>ts:install/0</c> <c>ts</c> - will run an autoconf script for your current - environment and set up the necessary variables needed by the - test suites. - </p> - <p><c>ts:install/1</c> or <c>ts:install/2</c> is used if the - target platform is different from the controller host, i.e. if - you run on "remote target" or if special options are required - for your system. - </p> - <p>See the reference manual for detailed information about - <c>ts:install/0/1/2</c>. - </p> - <p>Some of the common variables in the 'variables' file are - described below. Do not make any assumptions as of what is found - in this file, as it may change at any time. - </p> - <list> - <item><c>longnames</c><br></br> - Set to true if the system is using fully qualified - nodenames. - </item> - <item><c>platform_id</c><br></br> - This is the currently installed platform identification - string. - </item> - <item><c>platform_filename</c><br></br> - This is the name used to create the final save directory - for test runs. - </item> - <item><c>platform_label</c><br></br> - This is the string presented in the generated test - results index page. - </item> - <item><c>rsh_name</c><br></br> - This is the rsh program to use when starting slave or - peer nodes on a remote host. - </item> - <item><c>erl_flags</c><br></br> - Compile time flags used when compiling test suites. - </item> - <item><c>erl_release</c><br></br> - The Erlang/OTP release being tested. - </item> - <item><c>'EMULATOR'</c><br></br> - The emulator being tested (e.g. beam) - </item> - <item><c>'CPU'</c><br></br> - The CPU in the machine running the tests, e.g. sparc. - </item> - <item><c>target_host</c><br></br> - The target host name - </item> - <item><c>os</c><br></br> - The target operating system, e.g. solaris2.8 - </item> - <item><c>target</c><br></br> - The current target platform, e.g. sparc-sun-solaris2.8 - </item> - </list> - <p>RUNNING TESTS</p> - <p>After installing <c>ts</c>, you can run your test with the - <c>ts:run/0/1/2/3/4</c> functions. These functions, however, - require a special directory structure to be able to find your - test suites. Both the test server and all tests must be located - under your $TESTROOT directory. The test server implementation - shall be located in the directory <c>$TESTROOT/test_server</c> - and for each application there must be a directory named - <c><![CDATA[$TESTROOT/<application>_test]]></c> containing the .spec file - and all test suites and data directories for the - application. Note that there shall only be one .spec file for - each application. - </p> - <p><c>$TESTROOT/test_server</c> must be the current directory - when calling the <c>ts:run/*</c> function. - </p> - <p>All available tests can be found with <c>ts:tests()</c>. This - will list all applications for which a test specification file - <c><![CDATA[../<application>_test/<application>.spec]]></c> can be found. - </p> - <p>To run all these tests, use <c>ts:run()</c>. - </p> - <p>To run one or some of the tests, use <c>ts:run(Tests)</c>, - where <c>Tests</c> is the name of the application you want to - test, or a list of such names. - </p> - <p>To run one test suite within a test, use - <c>ts:run(Test,Suite)</c>. - </p> - <p>To run one test case within a suite, use - <c>ts:run(Test,Suite,Case)</c></p> - <p>To all these functions, you can also add a list of - options. Please turn to the reference manual for the <c>ts</c> - module to see the valid options to use. - </p> - <p>The function <c>ts:help()</c> displays some simple help for - the functions in <c>ts</c>. Use this for quick reference. - </p> - <p>LOG FILES</p> - <p>As the execution of the test suites go on, events are logged in - four different ways: - </p> - <list type="bulleted"> - <item>Text to the operator's console.</item> - <item>Suite related information is sent to the major log file.</item> - <item>Case related information is sent to the minor log file.</item> - <item>The HTML log file gets updated with test results.</item> - </list> - <p>Typically the operator, who may run hundreds or thousands of - test cases, doesn't want to fill the screen with details - about/from the specific test cases. By default, the operator will - only see: - </p> - <list type="bulleted"> - <item>A confirmation that the test has started. - </item> - <item>A small note about each failed test case. - </item> - <item>A summary of all the run test cases. - </item> - <item>A confirmation that the test run is complete - </item> - <item>Some special information like error reports and progress - reports, printouts written with erlang:display/1 or io:format/3 - specifically addressed to somewhere other than - <c>standard_io</c>.</item> - </list> - <p>This is enough for the operator to know, and if he wants to dig - in deeper into a specific test case result, he can do so by - following the links in the HTML presentation to take a look in the - major or minor log files. - </p> - <p>A detailed report of the entire test suite is stored in the - major logfile, the exact reason for failure, time spent etc. - </p> - <p>The HTML log file is a summary of the major log file, but gives - a much better overview of the test run. It also has links to every - test case's log file for quick viewing with a HTML browser. - </p> - <p>The minor log file contain full details of every single test - case, each one in a separate file. This way the files should be - easy to compare with previous test runs, even if the set of test - cases change. - </p> - <p>Which information that goes where is user configurable via the - test server controller. Three threshold values determine what - comes out on screen, and in the major or minor log files. The - contents that goes to the HTML log file is fixed, and cannot be - altered. - </p> - - </description> - <funcs> - <func> - <name>install() -> ok | {error, Reason}</name> - <name>install(TargetSystem) -> ok | {error, Reason}</name> - <name>install(Opts) -> ok | {error, Reason}</name> - <name>install(TargetSystem,Opts) -> ok | {error, Reason}</name> - <fsummary>Installs the Test Server Framework</fsummary> - <type> - <v>TargetSystem = {Architecture, TargetHost}</v> - <v>Architecture = atom() or string()</v> - <d>e.g. "ose" or "vxworks_ppc603"</d> - <v>TargetHost = atom() or string()</v> - <d>The name of the target host</d> - <v>Opts = list()</v> - </type> - <desc> - <p>Installs and configures the Test Server Framework for - running test suites. If a remote host is to be used, the - <c>TargetSystem</c> argument must be given so that "cross - installation" can be done. Installation is required for - any of the functions in <c>ts</c> to work. - </p> - <p>Opts may be one or more of - </p> - <list> - <item><c>{longnames, Bool}</c><br></br> - Use fully qualified hostnames for test_server and - slave nodes. Bool is <c>true</c> or <c>false</c> (default). - </item> - <item><c>{verbose, Level}</c><br></br> - Verbosity level for test server output, set to 0, 1 or - 2, where 0 is quiet(default). - </item> - <item><c>{hosts, Hosts}</c><br></br> - This is a list of available hosts on which to start - slave nodes. It is used when the <c>{remote, true}</c> - option is given to the <c>test_server:start_node/3</c> - function. Also, if <c>{require_nodenames, Num}</c> is - contained in a test specification file, the generated - nodenames will be spread over all hosts given in this - <c>Hosts</c> list. The hostnames are given as atoms or - strings. - </item> - <item><c>{slavetargets, SlaveTarges}</c><br></br> - For VxWorks only. This is a list of - available hosts where slave nodes can be started. This is - necessary because only one node can run per host in the - VxWorks environment. This is not the same as - <c>{hosts, Hosts}</c> because it is used for all slave nodes - - not only the ones started with <c>{remote, true}</c>. The - hostnames are given as atoms or strings. - </item> - <item><c>{crossroot, TargetErlRoot}</c><br></br> - Erlang root directory on target host - <br></br> -This option is mandatory for remote targets - </item> - <item><c>{master, {MasterHost, MasterCookie}}</c><br></br> - If target is remote and the target node is started as - a slave node, this option - indicates which master and cookie to use. The given master - will also be used as master for slave nodes started with - <c>test_server:start_node/3</c>. It is expected that the - <c>erl_boot_server</c> is started on the master node before - the test is run. If this option is not given, the test - server controller node is used as master and the - <c>erl_boot_server</c> is automatically started. - </item> - <item><c>{erl_start_args, ArgString}</c><br></br> - Additional arguments to be used when starting the test - server controller node. <c>ArgString</c> will be appended to - the command line when starting the erlang node. Note that - this will only affect the startup of the <em>controller node</em>, - i.e. not the target node or any slave nodes - startet from a test case. - </item> - <item><c>{ipv6_hosts, HostList}</c><br></br> - This option will be inserted in the - <c>Config</c> parameter for each test case. <c>HostList</c> - is a list of hosts supporting IPv6. - </item> - </list> - </desc> - </func> - <func> - <name>help() -> ok</name> - <fsummary>Presents simple help on the functions in <c>ts</c></fsummary> - <desc> - <p>Presents simple help on the functions in <c>ts</c>. Useful - for quick reference.</p> - </desc> - </func> - <func> - <name>tests() -> Tests</name> - <fsummary>Returns the list of available tests</fsummary> - <desc> - <p>Returns the list of available tests. This is actually just - a list of all test specification files found by looking up - "../*_test/*.spec". - </p> - <p>In each ../Name_test/ directory there should be one test - specification file named Name.spec.</p> - </desc> - </func> - <func> - <name>run() -> ok | {error, Reason}</name> - <name>run([all_tests|Opts])</name> - <name>run(Specs)</name> - <name>run(Specs, Opts)</name> - <name>run(Spec, Module)</name> - <name>run(Spec, Module, Opts)</name> - <name>run(Spec, Module, Case)</name> - <name>run(Spec, Module, Case, Opts)</name> - <fsummary>Runs (specified) test suite(s)</fsummary> - <type> - <v>Specs = Spec | [Spec]</v> - <v>Spec = atom()</v> - <v>Module = atom()</v> - <v>Case = atom()</v> - <v>Opts = [Opt]</v> - <v>Opt = batch | verbose | {verbose, Level} | {vars, Vars} | keep_topcase | cover | cover_details |{cover,CoverFile} | {cover_details,CoverFile} | {trace, TraceSpec}</v> - <v>Level = integer(); 0 means silent</v> - <v>Vars = list() of key-value tuples</v> - <v>CoverFile = string(); name of file listing modules to exclude from or include in cover compilation. The name must include full path to the file.</v> - <v>Reason = term()</v> - </type> - <desc> - <p>This function runs test suite(s)/case(s). To be able to run - any tests, ts:install must first be called to create the - <c>variables</c> file needed. To run a whole test specification, - only specify the name of the test specification, and all test - suite modules belonging to that test spec will be run. To run - a single module in a test specification, use the Module - argument to specify the name of the module to run and all test - cases in that module will be run, and to run a specified test - case, specify the name of the test case using the Case - argument. If called with no argument, all test specifications - available will be run. Use ts:tests/0 to see the available - test specifications. - </p> - <p>If the <c>batch</c> option is not given, a new xterm is - started (unix) when <c>ts:run</c> is called. - </p> - <p>The <c>verbose</c> option sets the verbosity level for test - server output. This has the same effect as if given to - <c>ts:install/1/2</c></p> - <p>The <c>vars</c> option can be used for adding configuration - variables that are not in the <c>variables</c> file generated - during installation. Can be any of the <c>Opts</c> valid for - <c>ts:install/1/2</c>. - </p> - <p>The <c>keep_topcase</c> option forces <c>ts</c> to keep the - topcase in your test specification file as is. This option can - only be used if you don't give the <c>Module</c> or - <c>Case</c> parameters to <c>ts:run</c>. The - <c>keep_topcase</c> option is necessary if your topcase - contains anything other than <c><![CDATA[{dir,"../<Name>_test"}]]></c>. If - the option is not used, <c>ts</c> will modify your topcase. - </p> - <p>The <c>cover</c> and <c>cover_details</c> options indicates - that the test shall be run with code coverage - analysis. <c>cover_details</c> means that analysis shall be - done on the most detailed level. If the test is run with a - remote target, this option creates a list of uncovered lines - in each cover compiled module. If the test is run with a local - target, each cover compiled module will be analysed with - <c>cover:analyse_to_file/1</c>. The <c>cover</c> options will - only create an overview of all cover compiled modules with the - number of covered and not covered lines. - </p> - <p>The <c>CoverFile</c> which can be given with the - <c>cover</c> and <c>cover_details</c> options must be the - filename of a file listing modules to be excluded from or - included in the cover compilation. By default, <c>ts</c> - believes that <c>Spec</c> is the name of an OTP application - and that all modules in this application shall be cover - compiled. The <c>CoverFile</c> can exclude modules that belong - to the application and add modules that don't belong to the - application. The file can have the following entries:</p> - <code type="none"> -{exclude, all | ExcludeModuleList}. -{include, IncludeModuleList}. </code> - <p>Note that each line must end with a full - stop. <c>ExcludeModuleList</c> and <c>IncludeModuleList</c> - are lists of atoms, where each atom is a module name. - </p> - <p>If the <c>cover</c> or <c>cover_details</c> options are - given on their own, the directory <c><![CDATA[../<Spec>_test]]></c> is - searched for a <c>CoverFile</c> named <c><![CDATA[<Spec>.cover]]></c>. If - this file is not found, <c>Spec</c> is assumed to be the name - of an OTP application, and all modules in the <c>ebin</c> - directory for the application are cover compiled. The - <c>ebin</c> directory is found by adding <c>ebin</c> to - <c>code:lib_dir(Spec)</c>. - </p> - <p>The same cover compiled code will be loaded on all slave or - peer nodes started with <c>test_server:start_node/3</c>. The - exception is nodes that run an old version of OTP. If the loading - fails, the node will simply not be a part of the coverage - analysis. Note that slave and peer nodes must be stopped with - <c>test_server:stop_node/1</c> for the node to be part of the - coverage analysis, else the test server will not be able to - fetch coverage data from the node. - </p> - <p>The <c>trace</c> option is used to turn on call trace on - target and on slave or peer nodes started with - <c>test_server:start_node/3</c>. <c>TraceSpec</c> can be the - name of a trace information file, or a list of elements like - the ones in a trace information file. Please turn to the - reference manual for <c>test_server_ctrl:trc/1</c> for details - about the trace information file. - </p> - </desc> - </func> - <func> - <name>cross_cover_analyse(Level) -> ok</name> - <name>cross_cover_analyse([Level]) -> ok</name> - <fsummary>Analyse cover data collected from all tests</fsummary> - <desc> - <p>Analyse cover data collected from all tests. - </p> - <p>See test_server_ctrl:cross_cover_analyse/2 - </p> - </desc> - </func> - <func> - <name>r() -> ok</name> - <name>r(Opts) -> ok</name> - <name>r(SpecOrSuite) -> ok</name> - <name>r(SpecOrSuite,Opts) -> ok</name> - <name>r(Suite,Case) -> ok</name> - <name>r(Suite,Case,Opts) -> ok</name> - <fsummary>Run test suite or test case without <c>ts</c>installed</fsummary> - <type> - <v>SpecOrSuite = Spec | Suite</v> - <v>Spec = string()</v> - <d>"Name.spec" or "Name.spec.OsType", where OsType is vxworks</d> - <v>Suite = atom()</v> - <v>Case = atom()</v> - <v>Opts = [Opt]</v> - <v>Opt = {Cover,AppOrCoverFile} | {Cover,Application,CoverFile}</v> - <v>Cover = cover | cover_details</v> - <v>AppOrCoverFile = Application | CoverFile</v> - <v>Application = atom()</v> - <d>OTP application to cover compile</d> - <v>CoverFile = string()</v> - <d>Name of file listing modules to exclude from or include in cover compilation</d> - </type> - <desc> - <p>This function can be used to run a test suites or test - cases directly, without any of the additional features added - by the test server framework. It is simply a wrapper function - for the <c>add_dir</c>, <c>add_spec</c>, <c>add_module</c> and - <c>add_case</c> functions in <c>test_server_ctrl</c>: - </p> - <p><c>r() -> add_dir(".")</c> <br></br> -<c>r(Spec) -> add_spec(Spec)</c> <br></br> -<c>r(Suite) -> add_module(Suite)</c> <br></br> -<c>r(Suite,Case) -> add_case(Suite,Case)</c></p> - <p>To use this function, it is required that the test suite is - compiled and in the code path of the node where the function - is called. The function can be used without having <c>ts</c> - installed. - </p> - <p>For information about the <c>cover</c> and - <c>cover_details</c> options, see <c>test_server_ctrl:cover/2/3</c>.</p> - </desc> - </func> - <func> - <name>estone() -> ok | {error, Reason}</name> - <name>estone(Opts) -> ok</name> - <fsummary>Runs the EStone test</fsummary> - <desc> - <p>This function runs the EStone test. It is a shortcut for - running the test suite <c>estone_SUITE</c> in the - <c>kernel</c> application. - </p> - <p><c>Opts</c> is the same as the <c>Opts</c> argument for the - <c>ts:run</c> functions.</p> - </desc> - </func> - </funcs> - - <section> - <title>Makfile.src in Data Directory</title> - <p>If a data directory contains code which must be compiled before - the test suite is run, a makefile source called - <c>Makefile.src</c> can be placed in the data directory. This file - will be converted to a valid makefile by <c>ts:run/0/1/2/3/4</c>. - </p> - <p>The reason for generating the makefile is that you can use - variables from the <c>variables</c> file which was generated by - <c>ts:install/0/1/2</c>. All occurrences of <c>@Key@</c> in - <c>Makefile.src</c> is substituted by the <c>Value</c> from - <c>{Key,Value}</c> found in the <c>variables</c> file. Example: - </p> - <p>Cut from <c>variables</c>:</p> - <code type="none"> - ... - {'EMULATOR',"beam"}. - {'CFLAGS',"-g -O2"}. - {'LD',"$(CC) $(CFLAGS)"}. - {'CC',"gcc"}. - ... - </code> - <p><c>Makefile.src</c> for compiling erlang code could look - something like this:</p> - <code type="none"> - EFLAGS=+debug_info - - all: ordsets1.@EMULATOR@ - - ordsets1.@EMULATOR@: ordsets1.erl - erlc $(EFLAGS) ordsets1.erl - </code> - <p><c>Makefile.src</c> for compiling c code could look - something like this:</p> - <code type="none"> - CC = @CC@ - LD = @LD@ - CFLAGS = @CFLAGS@ -I@erl_include@ @DEFS@ - CROSSLDFLAGS = @CROSSLDFLAGS@ - - PROGS = nfs_check@exe@ - - all: $(PROGS) - - nfs_check@exe@: nfs_check@obj@ - $(LD) $(CROSSLDFLAGS) -o nfs_check nfs_check@obj@ @LIBS@ - - nfs_check@obj@: nfs_check.c - $(CC) -c -o nfs_check@obj@ $(CFLAGS) nfs_check.c - </code> - </section> -</erlref> - diff --git a/lib/test_server/doc/src/why_test_chapter.xml b/lib/test_server/doc/src/why_test_chapter.xml deleted file mode 100644 index 3d0e8271b1..0000000000 --- a/lib/test_server/doc/src/why_test_chapter.xml +++ /dev/null @@ -1,141 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE chapter SYSTEM "chapter.dtd"> - -<chapter> - <header> - <copyright> - <year>2002</year><year>2013</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>Why Test</title> - <prepared>Siri Hansen</prepared> - <docno></docno> - <date></date> - <rev></rev> - </header> - - <section> - <title>Goals</title> - <p>It's not possible to prove that a program is correct by - testing. On the contrary, it has been formally proven that it is - impossible to prove programs in general by testing. Theoretical - program proofs or plain examination of code may be viable options - for those that wish to certify that a program is correct. The test - server, as it is based on testing, cannot be used for - certification. Its intended use is instead to (cost effectively) - <em>find bugs</em>. A successful test suite is one that reveals a - bug. If a test suite results in Ok, then we know very little that - we didn't know before. - </p> - </section> - - <section> - <title>What to test?</title> - <p>There are many kinds of test suites. Some concentrate on - calling every function in the interface to some module or - server. Some other do the same, but uses all kinds of illegal - parameters, and verifies that the server stays alive and rejects - the requests with reasonable error codes. Some test suites - simulate an application (typically consisting of a few modules of - an application), some try to do tricky requests in general, some - test suites even test internal functions. - </p> - <p>Another interesting category of test suites are the ones that - check that fixed bugs don't reoccur. When a bugfix is introduced, - a test case that checks for that specific bug should be written - and submitted to the affected test suite(s). - </p> - <p>Aim for finding bugs. Write whatever test that has the highest - probability of finding a bug, now or in the future. Concentrate - more on the critical parts. Bugs in critical subsystems are a lot - more expensive than others. - </p> - <p>Aim for functionality testing rather than implementation - details. Implementation details change quite often, and the test - suites should be long lived. Often implementation details differ - on different platforms and versions. If implementation details - have to be tested, try to factor them out into separate test - cases. Later on these test cases may be rewritten, or just - skipped. - </p> - <p>Also, aim for testing everything once, no less, no more. It's - not effective having every test case fail just because one - function in the interface changed. - </p> - </section> - - <section> - <title>How much to test</title> - <p>There is a unix shell script that counts the number of non - commented words (lines and characters too) of source code in each - application's test directory and divides with the number of such - source words in the src directory. This is a measure of how much - test code there is. - </p> - <p>There has been much debate over how much test code, compared to - production code, should be written in a project. More test code - finds more bugs, but test code needs to be maintained just like - the production code, and it's expensive to write it in the first - place. In several articles from relatively mature software - organizations that I have read, the amount of test code has been - about the same as the production code. </p> - <p>In OTP, at the time of - writing, few applications come even close to this, some have no - test code at all. - </p> - - <section> - <title>Full coverage</title> - <p>It is possible to cover compile the modules being tested - before running the test suites. Doing so displays which branches - of the code that are tested by the test suite, and which are - not. Many use this as a measure of a good test suite. When every - single line of source code is covered once by the test suite, - the test suite is finished. - </p> - <p>A coverage of 100% still proves nothing, though. It doesn't - mean that the code is error free, that everything is tested. For - instance, if a function contains a division, it has to be - executed at least twice. Once with parameters that cause - division by zero, and once with other parameters. - </p> - <p>High degree of coverage is good of course, it means that no - major parts of the code has been left untested. It's another - question whether it's cost effective. You're only likely to find - 50% more bugs when going from 67% to 100% coverage, but the work - (cost) is maybe 200% as large, or more, because reaching all of - those obscure branches is usually complicated. - </p> - <p>Again, the reason for testing with the test server is to find - bugs, not to create certificates of valid code. Maximizing the - number of found bugs per hour probably means not going for 100% - coverage. For some module the optimum may be 70%, for some other - maybe 250%. 100% shouldn't be a goal in itself.</p> - </section> - - <section> - <title>User interface testing</title> - <p>It is very difficult to do sensible testing of user - interfaces, especially the graphic ones. The test server has - some support for capturing the text I/O that goes to the user, - but none for graphics. There are several tools on the market - that help with this.</p> - </section> - </section> -</chapter> - diff --git a/lib/test_server/doc/src/write_framework_chapter.xml b/lib/test_server/doc/src/write_framework_chapter.xml deleted file mode 100644 index d10b580c34..0000000000 --- a/lib/test_server/doc/src/write_framework_chapter.xml +++ /dev/null @@ -1,160 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE chapter SYSTEM "chapter.dtd"> - -<chapter> - <header> - <copyright> - <year>2002</year><year>2013</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>Write you own test server framework</title> - <prepared>Siri Hansen</prepared> - <docno></docno> - <date></date> - <rev></rev> - <file>write_framework_chapter.xml</file> - </header> - - <section> - <title>Introduction</title> - <p>The test server controller can be interfaced from the operating - system or from within Erlang. The nature of your new framework - will decide which interface to use. If you want your framework to - start a new node for each test, the operating system interface is - very convenient. If your node is already started, going from - within Erlang might be a more flexible solution. - </p> - <p>The two methods are described below. - </p> - </section> - - <section> - <title>Interfacing the test server controller from Erlang</title> - <p>Using the test server from Erlang means that you have to start - the test server and then add test jobs. Use - <c>test_server_ctrl:start/0</c> to start the test server, and - <c>test_server_ctrl:stop/0</c> to stop it. - </p> - - <section> - <title>Adding test jobs</title> - <p>There are many commands available for adding test cases to - the test server's job queue: <br></br> -</p> - <list type="bulleted"> - <item>Single test case <br></br> -<c>test_server_ctrl:add_case/2/3</c></item> - <item>Multiple test cases from same suite <br></br> -<c>test_server_ctrl:add_cases/2/3</c></item> - <item>Test suite module or modules <br></br> -<c>test_server_ctrl:add_module/1/2</c></item> - <item>Some or all test suite modules in a directory <br></br> -<c>test_server_ctrl:add_dir/2/3</c></item> - <item>Test cases specified in a test specification file <br></br> -<c>test_server_ctrl:add_spec/1</c></item> - </list> - <p>All test suites are given a unique name, which is usually - given when the test suite is added to the job queue. In some - cases, a default name is used, as in the case when a module is - added without a specified name. The test job name is used to - store logfiles, which are stored in the `name.logs' directory - under the current directory. - </p> - <p>See the reference manual for details about the functions for - adding test jobs. - </p> - </section> - </section> - - <section> - <title>Interfacing the test server controller from the operating system.</title> - <p>The function <c>run_test/1</c> is your interface in the test - server controller if you wish to use it from the operating - system. You simply start an erlang shell and invoke this function - with the <c>-s</c> option. <c>run_test/1</c> starts the test - server, runs the test specified by the command line and stops the - test server. The argument to <c>run_test/1</c> is a list of - command line flags, typically - <c>['KEY1', Value1, 'KEY2', Value2, ...]</c>. - The valid command line flags are listed in the reference manual - for <c>test_server_ctrl</c>. - </p> - <p>A typical command line may look like this <br></br> -<c>erl -noshell -s test_server_ctrl run_test KEY1 Value1 KEY2 Value2 ... -s erlang halt</c></p> - <p>Or make an alias (this is for unix/tcsh) <br></br> -<c>alias erl_test 'erl -noshell -s test_server_ctrl run_test \!* -s erlang halt'</c></p> - <p>And then use it like this <br></br> -<c>erl_test KEY1 Value1 KEY2 Value2 ...</c> <br></br> -</p> - - <section> - <title>An Example</title> - <p>An example of starting a test run from the command line <br></br> -</p> - <p><c>erl -name test_srv -noshell -rsh /home/super/otp/bin/ctrsh </c> <br></br> -<c>-pa /clearcase/otp/erts/lib/kernel/test </c> <br></br> -<c>-boot start_sasl -sasl errlog_type error </c> <br></br> -<c>-s test_server_ctrl run_test SPEC kernel.spec -s erlang halt</c> <br></br> -</p> - </section> - </section> - - <section> - <title>Framework callback functions</title> - <p>By defining the environment variable - <c>TEST_SERVER_FRAMEWORK</c> to a module name, the framework - callback functions can be used. The framework callback functions - are called by the test server in order let the framework interact - with the execution of the tests and to keep the framework upto - date with information about the test progress. - </p> - <p>The framework callback functions are described in the reference - manual for <c>test_server_ctrl</c>. - </p> - <p>Note that this topic is in an early stage of development, and - changes might occur. - </p> - </section> - - <section> - <title>Other concerns</title> - <p>Some things to think about when writing you own test server - framework: - </p> - <list type="bulleted"> - <item><c>emulator version</c> - Make sure that the intended - version of the emulator is started. - </item> - <item><c>operating system path</c> - If test cases use port - programs, make sure the paths are correct. - </item> - <item><c>recompilation</c> - Make sure all test suites are fresh - compiled. - </item> - <item><c>test_server.hrl</c> - Make sure the - <c>test_server.hrl</c> file is in the include path when - compiling test suites. - </item> - <item><c>running applications</c> - Some test suites require - some applications to be running (e.g. sasl). Make sure they are - started. - </item> - </list> - </section> -</chapter> - diff --git a/lib/test_server/doc/src/write_test_chapter.xml b/lib/test_server/doc/src/write_test_chapter.xml deleted file mode 100644 index c3e1881b8a..0000000000 --- a/lib/test_server/doc/src/write_test_chapter.xml +++ /dev/null @@ -1,228 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE chapter SYSTEM "chapter.dtd"> - -<chapter> - <header> - <copyright> - <year>2002</year><year>2013</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>Writing Test Suites</title> - <prepared>Siri Hansen</prepared> - <docno></docno> - <date></date> - <rev></rev> - <file>write_test_chapter.xml</file> - </header> - - <section> - <title>Support for test suite authors</title> - <p>The <c>test_server</c> module provides some useful functions - to support the test suite author. This includes: - </p> - <list type="bulleted"> - <item>Starting and stopping slave or peer nodes</item> - <item>Capturing and checking stdout output</item> - <item>Retrieving and flushing process message queue</item> - <item>Watchdog timers</item> - <item>Checking that a function crashes</item> - <item>Checking that a function succeeds at least m out of n times</item> - <item>Checking .app files</item> - </list> - <p>Please turn to the reference manual for the <c>test_server</c> - module for details about these functions. - </p> - </section> - - <section> - <title>Test suites</title> - <p>A test suite is an ordinary Erlang module that contains test - cases. It's recommended that the module has a name on the form - *_SUITE.erl. Otherwise, the directory function will not find the - modules (by default). - </p> - <p>For some of the test server support, the test server include - file <c>test_server.hrl</c> must be included. Never include it - with the full path, for portability reasons. Use the compiler - include directive instead. - </p> - <p>The special function <c>all(suite)</c> in each module is called - to get the test specification for that module. The function - typically returns a list of test cases in that module, but any - test specification could be returned. Please see the chapter - about test specifications for details about this. - </p> - </section> - - <section> - <title>Init per test case</title> - <p>In each test suite module, the functions - <c>init_per_testcase/2</c> and <c>end_per_testcase/2</c> must be - implemented. - </p> - <p><c>init_per_testcase</c> is called before each test case in the - test suite, giving a (limited) possibility for initialization. - </p> - <p><c>end_per_testcase/2</c> is called after each test case is - completed, giving a possibility to clean up. - </p> - <p>The first argument to these functions is the name of the test - case. This can be used to do individual initialization and cleanup for - each test cases. - </p> - <p>The second argument is a list of tuples called - <c>Config</c>. The first element in a <c>Config</c> tuple - should be an atom - a key value to be used for searching. - <c>init_per_testcase/2</c> may modify the <c>Config</c> - parameter or just return it as is. Whatever is retuned by - <c>init_per_testcase/2</c> is given as <c>Config</c> parameter to - the test case itself. - </p> - <p>The return value of <c>end_per_testcase/2</c> is ignored by the - test server. - </p> - </section> - - <section> - <title>Test cases</title> - <p>The smallest unit that the test server is concerned with is a - test case. Each test case can in turn test many things, for - example make several calls to the same interface function with - different parameters. - </p> - <p>It is possible to put many or few tests into each test - case. How many things each test case tests is up to the author, - but here are some things to keep in mind. - </p> - <p>Very small test cases often leads to more code, since - initialization has to be duplicated. Larger code, especially with - a lot of duplication, increases maintenance and reduces - readability. - </p> - <p>Larger test cases make it harder to tell what went wrong if it - fails, and force us to skip larger portions of test code if a - specific part fails. These effects are accentuated when running on - multiple platforms because test cases often have to be skipped. - </p> - <p>A test case generally consists of three parts, the - documentation part, the specification part and the execution - part. These are implemented as three clauses of the same function. - </p> - <p>The documentation clause matches the argument '<c>doc</c>' and - returns a list for strings describing what the test case tests. - </p> - <p>The specification clause matches the argument '<c>suite</c>' - and returns the test specification for this particular test - case. If the test specification is an empty list, this indicates - that the test case is a leaf test case, i.e. one to be executed. - </p> - <p>The execution clause implements the actual test case. It takes - one argument, <c>Config</c>, which contain configuration - information like <c>data_dir</c> and <c>priv_dir</c>. See <seealso marker="#data_priv_dir">Data and Private Directories</seealso> for - more information about these. - </p> - <p>The <c>Config</c> variable can also contain the - <c>nodenames</c> key, if requested by the <c>require_nodenames</c> - command in the test suite specification file. All <c>Config</c> - items should be extracted using the <c>?config</c> macro. This is - to ensure future compatibility if the <c>Config</c> format - changes. See the reference manual for <c>test_server</c> for - details about this macro. - </p> - <p>If the execution clause crashes or exits, it is considered a - failure. If it returns <c>{skip,Reason}</c>, the test case is - considered skipped. If it returns <c>{comment,String}</c>, - the string will be added in the 'Comment' field on the HTML - result page. If the execution clause returns anything else, it is - considered a success, unless it is <c>{'EXIT',Reason}</c> or - <c>{'EXIT',Pid,Reason}</c> which can't be distinguished from a - crash, and thus will be considered a failure. - </p> - </section> - - <section> - <marker id="data_priv_dir"></marker> - <title>Data and Private Directories</title> - <p>The data directory (<c>data_dir</c>) is the directory where the test - module has its own files needed for the testing. A compiler test - case may have source files to feed into the compiler, a release - upgrade test case may have some old and new release of - something. A graphics test case may have some icons and a test - case doing a lot of math with bignums might store the correct - answers there. The name of the <c>data_dir</c> is the the name of - the test suite and then "_data". For example, - <c>"some_path/foo_SUITE.beam"</c> has the data directory - <c>"some_path/foo_SUITE_data/"</c>. - </p> - <p>The <c>priv_dir</c> is the test suite's private directory. This - directory should be used when a test case needs to write to - files. The name of the private directory is generated by the test - server, which also creates the directory. - </p> - <p><em>Warning:</em> Do not depend on current directory to be - writable, or to point to anything in particular. All scratch files - are to be written in the <c>priv_dir</c>, and all data files found - in <c>data_dir</c>. If the current directory has to be something - specific, it must be set with <c>file:set_cwd/1</c>. - </p> - </section> - - <section> - <title>Execution environment</title> - <p>Each time a test case is about to be executed, a new process is - created with <c>spawn_link</c>. This is so that the test case will - have no dependencies to earlier tests, with respect to process flags, - process links, messages in the queue, other processes having registered - the process, etc. As little as possible is done to change the initial - context of the process (what is created by plain spawn). Here is a - list of differences: - </p> - <list type="bulleted"> - <item>It has a link to the test server. If this link is removed, - the test server will not know when the test case is finished, - just wait infinitely. - </item> - <item>It often holds a few items in the process dictionary, all - with names starting with '<c>test_server_</c>'. This is to keep - track of if/where a test case fails. - </item> - <item>There is a top-level catch. All of the test case code is - catched, so that the location of a crash can be reported back to - the test server. If the test case process is killed by another - process (thus the catch code is never executed) the test server - is not able to tell where the test case was executing. - </item> - <item>It has a special group leader implemented by the test - server. This way the test server is able to capture the io that - the test case provokes. This is also used by some of the test - server support functions. - </item> - </list> - <p>There is no time limit for a test case, unless the test case - itself imposes such a limit, by calling - <c>test_server:timetrap/1</c> for example. The call can be made - in each test case, or in the <c>init_per_testcase/2</c> - function. Make sure to call the corresponding - <c>test_server:timetrap_cancel/1</c> function as well, e.g in the - <c>end_per_testcase/2</c> function, or else the test cases will - always fail. - </p> - </section> - -</chapter> - diff --git a/lib/test_server/ebin/.gitignore b/lib/test_server/ebin/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/test_server/ebin/.gitignore +++ /dev/null diff --git a/lib/test_server/include/test_server.hrl b/lib/test_server/include/test_server.hrl deleted file mode 100644 index 77864ef3b5..0000000000 --- a/lib/test_server/include/test_server.hrl +++ /dev/null @@ -1,32 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2011. 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(line_trace). --line_trace(true). --define(line, - io:format(lists:concat([?MODULE,",",integer_to_list(?LINE),": ~p"]), - [erlang:monotonic_time()-erlang:system_info(start_time)]),). --else. --define(line,). --endif. --define(t,test_server). --define(config,test_server:lookup_config). - - diff --git a/lib/test_server/include/test_server_line.hrl b/lib/test_server/include/test_server_line.hrl deleted file mode 100644 index 37da956cd0..0000000000 --- a/lib/test_server/include/test_server_line.hrl +++ /dev/null @@ -1,20 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2011. 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% -%% - diff --git a/lib/test_server/info b/lib/test_server/info deleted file mode 100644 index 7a9ed6c700..0000000000 --- a/lib/test_server/info +++ /dev/null @@ -1,2 +0,0 @@ -group: test Test Applications -short: The OTP Test Server diff --git a/lib/test_server/prebuild.skip b/lib/test_server/prebuild.skip deleted file mode 100644 index 8ee4101f6a..0000000000 --- a/lib/test_server/prebuild.skip +++ /dev/null @@ -1 +0,0 @@ -src/autom4te.cache diff --git a/lib/test_server/src/Makefile b/lib/test_server/src/Makefile deleted file mode 100644 index 6a26ee2933..0000000000 --- a/lib/test_server/src/Makefile +++ /dev/null @@ -1,144 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1996-2013. 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_TOP)/make/target.mk - -# ---------------------------------------------------- -# Configuration info. -# ---------------------------------------------------- -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../vsn.mk -VSN=$(TEST_SERVER_VSN) - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/test_server-$(VSN) - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- - -MODULES= test_server_ctrl \ - test_server_gl \ - test_server_io \ - test_server_node \ - test_server \ - test_server_sup \ - erl2html2 - -TS_MODULES= \ - ts \ - ts_run \ - ts_lib \ - ts_make \ - ts_erl_config \ - ts_autoconf_win32 \ - ts_install \ - ts_install_cth \ - ts_benchmark - -TARGET_MODULES= $(MODULES:%=$(EBIN)/%) -TS_TARGET_MODULES= $(TS_MODULES:%=$(EBIN)/%) - -ERL_FILES= $(MODULES:=.erl) -TS_ERL_FILES= $(TS_MODULES:=.erl) -HRL_FILES = ../include/test_server.hrl ../include/test_server_line.hrl -INTERNAL_HRL_FILES = test_server_internal.hrl -TS_HRL_FILES= ts.hrl -C_FILES = -AUTOCONF_FILES = configure.in conf_vars.in -PROGRAMS = configure config.sub config.guess install-sh -CONFIG = ts.config ts.unix.config ts.win32.config - -TARGET_FILES = $(MODULES:%=$(EBIN)/%.$(EMULATOR)) \ - $(APP_TARGET) $(APPUP_TARGET) -TS_TARGET_FILES = $(TS_MODULES:%=$(EBIN)/%.$(EMULATOR)) - -TARGETS = $(MODULES:%=$(EBIN)/%.$(EMULATOR)) $(PROGRAMS) \ - $(APP_TARGET) $(APPUP_TARGET) -TS_TARGETS = $(TS_MODULES:%=$(EBIN)/%.$(EMULATOR)) - -APP_FILE= test_server.app -APP_SRC= $(APP_FILE).src -APP_TARGET= $(EBIN)/$(APP_FILE) - -APPUP_FILE= test_server.appup -APPUP_SRC= $(APPUP_FILE).src -APPUP_TARGET= $(EBIN)/$(APPUP_FILE) - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -ERL_COMPILE_FLAGS += -I../include -Werror - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -tests debug opt: $(TARGETS) $(TS_TARGETS) - -clean: - rm -f $(TARGET_FILES) $(TS_TARGET_FILES) - rm -f core - -docs: - -configure: configure.in - autoconf configure.in > configure - -# ---------------------------------------------------- -# Special Build Targets -# ---------------------------------------------------- -$(APP_TARGET): $(APP_SRC) ../vsn.mk - $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@ - -$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk - $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@ - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_spec: opt - $(INSTALL_DIR) "$(RELSYSDIR)/src" - $(INSTALL_DATA) $(ERL_FILES) "$(RELSYSDIR)/src" - $(INSTALL_DATA) $(INTERNAL_HRL_FILES) $(TS_HRL_FILES) "$(RELSYSDIR)/src" - $(INSTALL_DIR) "$(RELSYSDIR)/include" - $(INSTALL_DATA) $(HRL_FILES) "$(RELSYSDIR)/include" - $(INSTALL_DIR) "$(RELSYSDIR)/ebin" - $(INSTALL_DATA) $(TARGET_FILES) "$(RELSYSDIR)/ebin" - -release_tests_spec: opt - $(INSTALL_DIR) "$(RELEASE_PATH)/test_server" - $(INSTALL_DATA) $(ERL_FILES) $(TS_ERL_FILES) \ - $(HRL_FILES) $(INTERNAL_HRL_FILES) $(TS_HRL_FILES) \ - $(TS_TARGET_FILES) \ - $(AUTOCONF_FILES) $(C_FILES) $(CONFIG) \ - "$(RELEASE_PATH)/test_server" - $(INSTALL_SCRIPT) $(PROGRAMS) "$(RELEASE_PATH)/test_server" - -release_docs_spec: - diff --git a/lib/test_server/src/things/distr_startup_SUITE.erl b/lib/test_server/src/things/distr_startup_SUITE.erl deleted file mode 100644 index aa84ab007f..0000000000 --- a/lib/test_server/src/things/distr_startup_SUITE.erl +++ /dev/null @@ -1,239 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. 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(distr_startup_SUITE). --compile([export_all]). -%%-define(line_trace,1). --include("test_server.hrl"). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -all(suite) -> [reads,writes]. - --define(iterations,10000). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -app1() -> - {application, app1, - [{description, "ERTS CXC 138 10"}, - {vsn, "2.0"}, - {applications, [kernel, stdlib]}, - {mod, {ch_sup, {app1, 1, 3}}}]}. - -app3() -> - {application, app3, - [{description, "ERTS CXC 138 10"}, - {vsn, "2.0"}, - {applications, [kernel, stdlib]}, - {mod, {ch_sup, {app3, 7, 9}}}]}. - - -config(Fd,C1,C2,C3) -> - io:format(Fd, - "[{kernel, [{sync_nodes_optional, ['~s','~s','~s']}," - "{sync_nodes_timeout, 1}," - "{distributed, [{app1, ['~s', '~s', '~s']}," - "{app2, 10000, ['~s', '~s', '~s']}," - "{app3, 5000, [{'~s', '~s'}, '~s']}]}]}].~n", - [C1,C2,C3, C1,C2,C3, C1,C2,C3, C1,C2,C3]). - -from(H, [H | T]) -> T; -from(H, [_ | T]) -> from(H, T); -from(H, []) -> []. - -%%----------------------------------------------------------------- -%% Test suite for distributed applications, tests start, load -%% etc indirectly. -%% Should be started in a CC view with: -%% erl -sname master -rsh ctrsh -%%----------------------------------------------------------------- -start_nodes(Conf) -> - % Write a config file - ?line Nodes = ?config(nodes,Conf), - ?line [C1,C2,C3|_] = Nodes, %% Need at least 3 nodes - ?line Dir = ?config(priv_dir,Conf), - ?line {ok, Fd} = file:open(Dir ++ "sys.config", write), - ?line config(Fd,C1,C2,C3), - ?line file:close(Fd), - ?line Config = Dir ++ "sys", - - % Test [cp1, cp2, cp3] - ?line {ok, Cp1} = start_node(lists:nth(1,Nodes), Config), - ?line {ok, Cp2} = start_node(lists:nth(2,Nodes), Config), - ?line {ok, Cp3} = start_node(lists:nth(3,Nodes), Config), - % Start app1 and make sure cp1 starts it - %%?line rpc:multicall([Cp1, Cp2, Cp3], application, load, [app1()]), - %%?line rpc:multicall([Cp1, Cp2, Cp3], application, start,[app1,permanent]), - ?line test_server:sleep(1000), - {Cp1,Cp2,Cp3}. - -stop_nodes({Cp1,Cp2,Cp3}) -> - ?line stop_node(Cp1), - ?line stop_node(Cp2), - ?line stop_node(Cp3). - -start_node(NodeAtHost, Config) -> - ?line NodeAtHostStr = atom_to_list(NodeAtHost), - ?line HostStr = from($@,NodeAtHostStr), - ?line NodeStr = lists:reverse(from($@,lists:reverse(NodeAtHostStr))), - ?line Host = list_to_atom(HostStr), - ?line Node = list_to_atom(NodeStr), - ?line io:format("Launching slave node ~p@~p ~p",[Node,Host,Config]), - ?line slave:start(Host, Node, lists:concat(["-config ", Config])). - -stop_node(Node) -> - ?line rpc:cast(Node, erlang, halt, []). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -start_client_process(Cp,Mode,NodeNum) -> - io:format("Starting client process at ~p in mode ~p",[Cp,Mode]), - ?line case rpc:call(Cp, erlang, spawn, - [?MODULE, client, - [Mode,NodeNum,self(),random:uniform(1000)]]) of - {badrpc,Reason} -> - ?line exit({badrpc,{Cp,Reason}}); - Client -> - ?line Client - end. - -start_clients(Mode,Conf) -> - ?line random:seed(4711,0,0), - ?line {Cp1,Cp2,Cp3} = start_nodes(Conf), - ?line Client1 = start_client_process(Cp1,Mode,1), - ?line Client2 = start_client_process(Cp2,Mode,2), - ?line Client3 = start_client_process(Cp3,Mode,3), - test_server:format(1,"All 3 nodes started, " - "power off client(s) any time...",[]), - Client1 ! go, - Client2 ! go, - Client3 ! go, - {{Cp1,Cp2,Cp3},{Client1,Client2,Client3}}. - -stop_clients(Cps) -> - test_server:format(1,"Test completed.",[]), - ?line stop_nodes(Cps). - -data() -> - {{self(),foo,bar,[1,2,3,4,5,6,7],{{{{}}}}, - "We need pretty long packages, so that there is a big risk " - "of cutting it in the middle when suddenly turning off " - "the power or breaking the connection. " - "We don't check the contents of the data very much, but " - "at least there is a magic cookie at the end (123456)." - "If that one arrives correctly, the link is ok as far " - "as we are concerned."}, - 123456}. - -reads(suite) -> []; -reads(Conf) -> - ?line {Cps,_} = start_clients(w,Conf), - ?line read_loop(?iterations,0), - ?line stop_clients(Cps), - ok. - -read_loop(0,M) -> - ok; -read_loop(N,M) -> - ?line Dog = test_server:timetrap(test_server:seconds(0.5)), - M2 = - receive - {Node,Count,{_,123456}} -> - ?line setelement(Node,M,element(Node,M)+1); - {Node,Count,Data} -> - ?line exit({network_transmission_error,Data}); - {nodedown,Node} -> - ?line test_server:format(1,"Node ~s went down",[Node]), - ?line M; - Other -> - ?line M - after test_server:seconds(0.1) -> - ?line io:format("No message!"), - ?line M - end, - ?line test_server:timetrap_cancel(Dog), - ?line M3 = - case N rem 100 of - 0 -> io:format("~p reads to go (~w msgs)",[N,M2]), - {0,0,0}; - _ -> M2 - end, - ?line read_loop(N-1,M3). - -client(w,NodeNum,Pid,Seed) -> - random:seed(Seed,0,0), - receive - go -> ok - end, - client_write_loop(Pid,0,NodeNum,data()); -client(r,NodeNum,Pid,Seed) -> - random:seed(Seed,0,0), - receive - go -> ok - end, - client_read_loop(0). - -client_write_loop(Pid,N,NodeNum,Data) -> - test_server:sleep(random:uniform(20)), - Pid ! {NodeNum,N,Data}, - client_write_loop(Pid,N+1,NodeNum,Data). - -writes(suite) -> []; -writes(Conf) -> - ?line {Cps,{C1,C2,C3}} = start_clients(r,Conf), - ?line write_loop(2*?iterations,{C1,C2,C3},data()), - ?line stop_clients(Cps), - ok. - -write_loop(0,_,_) -> - ok; -write_loop(N,Clients,Data) -> - ?line Dog = test_server:timetrap(test_server:seconds(0.5)), - ?line Client = element(random:uniform(size(Clients)),Clients), - ?line Client ! {node(),N,Data}, - ?line test_server:timetrap_cancel(Dog), - receive - {nodedown,Node} -> - ?line test_server:format(1,"Node ~s went down",[Node]) - after 0 -> - ?line ok - end, - ?line case N rem 100 of - 0 -> io:format("~p writes to go",[N]); - _ -> ok - end, - ?line write_loop(N-1,Clients,Data). - -client_read_loop(N) -> - receive - {Node,Count,{_,123456}} -> - ?line ok; - {Node,Count,Data} -> - ?line io:format("~p(~p): transmission error from node ~p(~p): ~p", - [node(),N,Node,Count,Data]); - Other -> - ?line io:format("~p(~p): got a strange message: ~p", - [node(),N,Other]) - end, - client_read_loop(N+1). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - diff --git a/lib/test_server/src/things/mnesia_power_SUITE.erl b/lib/test_server/src/things/mnesia_power_SUITE.erl deleted file mode 100644 index e9bc75e583..0000000000 --- a/lib/test_server/src/things/mnesia_power_SUITE.erl +++ /dev/null @@ -1,126 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. 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(mnesia_power_SUITE). --compile([export_all]). -%%-define(line_trace,1). --include("test_server.hrl"). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -all(suite) -> [run]. - --define(iterations,3). %% nof power-off cycles to do before acceptance --define(rows,8). %% nof database rows to use (not too big, please) - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - --record(sum_table_1,{row,a,b,c,s}). - -run(suite) -> []; -run(Config) -> - ?line mnesia:create_schema([node()]), - ?line mnesia:start(), - ?line mnesia:create_table([{name, sum_table_1}, {disc_copies,[node()]}, - {attributes,record_info(fields,sum_table_1)}]), - ?line run_test(Config,?iterations). - -run(Config,N) -> - ?line mnesia:start(), - ?line check_consistency(sum_table_1), - case N of - 0 -> ?line ok; - N -> ?line run_test(Config,N) - end. - -run_test(Config,N) -> - ?line Pid1a = start_manipulator(sum_table_1), - ?line Pid1b = start_manipulator(sum_table_1), - ?line Pid1c = start_manipulator(sum_table_1), - ?line test_server:resume_point(?MODULE,run,[Config,N-1]), - ?line test_server:format(1,"Manipulating data like crazy now, " - "power off any time..."), - ?line test_server:sleep(infinity). - -start_manipulator(Table) -> - ?line spawn_link(?MODULE,manipulator_init,[Table]). - -manipulator_init(Table) -> - random:seed(4711,0,0), - manipulator(0,Table). - -manipulator(N,Table) -> - ?line Fun = - fun() -> - ?line Row = random:uniform(?rows), - ?line A = random:uniform(100000), - ?line B = random:uniform(100000), - ?line C = random:uniform(100000), - ?line Sum = A+B+C, - ?line case mnesia:write(#sum_table_1 - {row=Row,a=A,b=B,c=C,s=Sum}) of - ok -> ok; - Other -> - ?line io:format("Trans failed: ~p\n",[Other]) - end - end, - ?line mnesia:transaction(Fun), - case mnesia:table_info(sum_table_1,size) of - 0 -> exit(still_empty); - _ -> ok - end, - case N rem 2000 of - 0 -> io:format("~p did ~p operations",[self(),N]), - check_consistency(sum_table_1); - _ -> ok - end, - ?line manipulator(N+1,Table). - -check_consistency(Table) -> - io:format("Checking consistency of table ~p\n",[Table]), - All = mnesia:table_info(Table,wild_pattern), - ?line Fun = - fun() -> - mnesia:match_object(All) - end, - ?line case mnesia:transaction(Fun) of - {atomic,Val} -> - check_consistency_rows(Val,0); - Other -> - io:format("Trans failed: ~p\n",[Other]), - exit(failed), - check_consistency(Table) - end. - -check_consistency_rows([#sum_table_1{a=A,b=B,c=C,s=Sum}|Rows],N) -> - ?line Sum=A+B+C, - ?line check_consistency_rows(Rows,N+1); -check_consistency_rows([],N) -> - io:format("All ~p rows were consistent\n",[N]), - {ok,N}; -check_consistency_rows(Thing,N) -> - io:format("Mnesia transaction returned:\n~p\n",[Thing]), - exit({bad_format,Thing}). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - - - - diff --git a/lib/test_server/src/things/random_kill_SUITE.erl b/lib/test_server/src/things/random_kill_SUITE.erl deleted file mode 100644 index 917bc2b3d5..0000000000 --- a/lib/test_server/src/things/random_kill_SUITE.erl +++ /dev/null @@ -1,82 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. 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(random_kill_SUITE). --compile([export_all]). -%%-define(line_trace,1). --include("test_server.hrl"). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -all(suite) -> [run]. - --define(iterations,25). %% Kill this many processes, - %% possibly with reboots in between - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -run(suite) -> []; -run(Config) -> - registered(?iterations). - -registered(0) -> - ok; -registered(N) -> - random:seed(3461*N,1159*N,351*N), - Pid = select_victim(registered), - test_server:resume_point(?MODULE,registered,[N-1]), - test_server:format("About to kill pid ~p (~p)\n~p", - [Pid,process_info(Pid,registered_name),info(Pid)]), - %%exit(Pid,kill), - registered(N-1). - -info(Pid) -> - Rest0 = tl(pid_to_list(Pid)), - {P1,Rest1} = get_until($.,Rest0), - {P2,Rest2} = get_until($.,Rest1), - {P3,_} = get_until($>,Rest2), - c:i(list_to_integer(P1),list_to_integer(P2),list_to_integer(P3)). - -get_until(Ch,L) -> - get_until(Ch,L,[]). -get_until(Ch,[],Acc) -> - {lists:reverse(Acc),[]}; -get_until(Ch,[Ch|T],Acc) -> - {lists:reverse(Acc),T}; -get_until(Ch,[H|T],Acc) -> - get_until(Ch,T,[H|Acc]). - -select_victim(registered) -> - Pids = - lists:map(fun(Server)-> whereis(Server) end,registered()), - ImmunePids = - [self()|lists:map(fun(Job)-> element(2,Job) end,test_server:jobs())], - SuitablePids = - lists:filter(fun(Pid)-> case lists:member(Pid,ImmunePids) of - true -> false; - false -> true - end - end, Pids), - Selected = random:uniform(length(SuitablePids)), - io:format("Selected ~p if ~p",[Selected,length(SuitablePids)]), - lists:nth(Selected,SuitablePids). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - diff --git a/lib/test_server/src/things/soft.gs.txt b/lib/test_server/src/things/soft.gs.txt deleted file mode 100644 index ec57884997..0000000000 --- a/lib/test_server/src/things/soft.gs.txt +++ /dev/null @@ -1,16 +0,0 @@ -6> gs:start(). -RealTimeViolation, 478ms (after 1164 good) -{1,<0.65.0>} -RealTimeViolation, 352ms (after 0 good) -RealTimeViolation, 492ms (after 0 good) -RealTimeViolation, 166ms (after 0 good) -RealTimeInfo, 18ms (after 7 good) -RealTimeViolation, 115ms (after 13 good) -7> application-specific initialization failed: couldn't connect to display ":0.0" -RealTimeViolation, 20340ms (after 0 good) -gs error: user backend died reason {port_handler,#Port,normal} - -RealTimeInfo, 31ms (after 21 good) -RealTimeInfo, 21ms (after 69 good) -RealTimeInfo, 21ms (after 119 good) -RealTimeInfo, 21ms (after 169 good) diff --git a/lib/test_server/src/things/verify.erl b/lib/test_server/src/things/verify.erl deleted file mode 100644 index b09d0fbda9..0000000000 --- a/lib/test_server/src/things/verify.erl +++ /dev/null @@ -1,200 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. 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(verify). - --export([dir/0, dir/1]). - -%% usage verify:dir() -%% or verify:dir(Dir) -%% -%% runs tests on all files with the extension ".t1" -%% creates an error log file verify.log in the directory where the -%% tests were run - --import(lists, [reverse/1, foldl/3, map/2]). - -dir() -> - dir("."). - -dir(Dir) -> - case file:list_dir(Dir) of - {ok, Files} -> - VFiles = collect_vers(Files, []), - VFiles1 = map(fun(F) -> Dir ++ "/" ++ F end, VFiles), - Nerrs = foldl(fun(F, Sum) -> - case file(F) of - {file,_,had,N,errors} -> - Sum + N; - no_errors -> - Sum; - Other -> - Sum + 1 - end - end, 0, VFiles1), - case Nerrs of - 0 -> no_errors; - _ -> {dir,Dir,had,Nerrs,errors} - end; - _ -> - {error, cannot,list_dir, Dir} - end. - -collect_vers([H|T], L) -> - case reverse(H) of - [$1,$t,$.|T1] -> collect_vers(T, [reverse(T1)|L]); - _ -> collect_vers(T, L) - end; -collect_vers([], L) -> - L. - -file(File) -> - case file:open(File ++ ".t1", read) of - {ok, S} -> - io:format("Verifying: ~s\n", [File]), - ErrFile = File ++ ".errs", - {ok, E} = file:open(ErrFile, write), - Bind0 = erl_eval:new_bindings(), - NErrs = do(S, {E, File, Bind0, 0}, 1), - file:close(S), - file:close(E), - case NErrs of - 0 -> - file:delete(ErrFile), - no_errors; - _ -> - {file,File,had,NErrs,errors} - end; - _ -> - error_in_opening_file - end. - -do(S, Env, Line) -> - R = io:scan_erl_exprs(S, '', Line), - do1(R, S, Env). - -do1({eof,_}, _, {_,_,_,NErrs}) -> - NErrs; -do1({ok,Toks,Next}, S, Env0) -> - E1 = handle_toks(Toks, Next, Env0), - do(S, E1, Next); -do1({error, {Line,Mod,Args}, Next}, S, E) -> - io:format("*** ~w ~p~n", [Line,Mod:format_error(Args)]), - E1 = add_error(E), - do(S, E1, Next). - -add_error({Stream, File, Bindings, N}) -> {Stream, File, Bindings, N+1}. - -handle_toks(Toks, Line, Env0) -> - %% io:format("Toks:~p\n", [Toks]). - case erl_parse:parse_exprs(Toks) of - {ok, Exprs} -> - %% io:format("Got:~p\n", [Exprs]), - eval(Exprs, Line, Env0); - {error, {LineNo, Mod, What}} -> - Str = apply(Mod, format_error, [What]), - io:format("*** Line:~w ***~s\n", [LineNo, Str]), - add_error(Env0); - Parse_error -> - io:format("Parse Error:~p\n",[Parse_error]), - add_error(Env0) - end. - -forget([{var,_,Name}], B0) -> erl_eval:del_binding(Name, B0); -forget([], _) -> erl_eval:new_bindings(). - -eval([{call,_,{atom,_,f}, Args}], _, {Stream, Bind0, Errs}) -> - Bind1 = forget(Args, Bind0), - {Stream, Bind1, Errs}; -eval(Exprs, Line, {Stream, File, Bind0, NErrs}) -> - %% io:format("Bindings >> ~p\n", [Bind0]), - %% io:format("Exprs >> ~p\n", [Exprs]), - case catch erl_eval:exprs(Exprs, Bind0) of - {'EXIT', Reason} -> - out_both(Stream, "----------------------------------~n", []), - out_both(Stream, "File:~s Error in:~s~n", [File, pp(Exprs)]), - print_bindings(Stream, Exprs, Bind0), - print_lhs(Stream, Exprs), - out_both(Stream, '*** Rhs evaluated to:~p~n',[rhs(Exprs, Bind0)]), - {Stream, File, Bind0, NErrs+1}; - {value, _, Bind1} -> - {Stream, File, Bind1, NErrs} - end. - -pp([H]) -> erl_pp:expr(H); -pp([H|T]) -> [erl_pp:expr(H),$,|pp(T)]; -pp([]) -> []. - -print_bindings(E, Form, Bindings) -> - case varsin(Form) of - [] -> - true; - Vars -> - print_vars(E, Vars, Bindings) - end. - -print_vars(E, [Var|T], Bindings) -> - case erl_eval:binding(Var, Bindings) of - {value, Val} -> - out_both(E, '~s = ~p\n',[Var, Val]); - unbound -> - out_both(E, '~s *is unbound*\n', [Var]) - end, - print_vars(E, T, Bindings); -print_vars(_, [], _) -> - true. - - -out_both(E, Format, Data) -> - io:format(Format, Data), - io:format(E, Format, Data). - -print_lhs(E, [{match, _, Lhs, Rhs}]) -> - %% io:format(">>>> here:~w\n",[Lhs]), - out_both(E, '*** Lhs was:~s\n',[erl_pp:expr(Lhs)]); -print_lhs(E, _) -> - out_both(E, '** UNDEFINED **', []). - - -rhs([{match, _, Lhs, Rhs}], Bindings) -> - case catch erl_eval:exprs([Rhs], Bindings) of - {value, Val, _} -> Val; - Other -> undefined() - end; -rhs(_, _) -> - undefined(). - -varsin(X) -> varsin(X, []). - -varsin({var,_,'_'}, L) -> - L; -varsin({var,_,V}, L) -> - case lists:member(V, L) of - true -> L; - false -> [V|L] - end; -varsin([H|T], L) -> - varsin(T, varsin(H, L)); -varsin(T, L) when tuple(T) -> - varsin(tuple_to_list(T), L); -varsin(_, L) -> - L. - -undefined() -> - '** UNDEFINED **'. diff --git a/lib/test_server/test/Makefile b/lib/test_server/test/Makefile deleted file mode 100644 index 8eec940505..0000000000 --- a/lib/test_server/test/Makefile +++ /dev/null @@ -1,92 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1997-2012. 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_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- - -MODULES= \ - test_server_SUITE \ - test_server_test_lib \ - erl2html2_SUITE - -ERL_FILES= $(MODULES:%=%.erl) - -TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) -INSTALL_PROGS= $(TARGET_FILES) - -EMAKEFILE=Emakefile -COVERFILE=test_server.cover - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/test_server_test - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- - -ERL_MAKE_FLAGS += -pa $(ERL_TOP)/lib/test_server/ebin -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/test - -EBIN = . - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -.PHONY: make_emakefile - -make_emakefile: - $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) \ - '*_SUITE_make' > $(EMAKEFILE) - $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) $(MODULES)\ - >> $(EMAKEFILE) - -tests debug opt: make_emakefile - erl $(ERL_MAKE_FLAGS) -make - -clean: - rm -f $(EMAKEFILE) - rm -f $(TARGET_FILES) $(GEN_FILES) - rm -f core - -docs: - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_spec: opt - -release_tests_spec: make_emakefile - $(INSTALL_DIR) "$(RELSYSDIR)" - $(INSTALL_DATA) $(EMAKEFILE) $(ERL_FILES) $(COVERFILE) "$(RELSYSDIR)" - $(INSTALL_DATA) test_server_test_lib.hrl test_server.spec test_server.cover "$(RELSYSDIR)" - chmod -R u+w "$(RELSYSDIR)" - @tar cf - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -) - -release_docs_spec: diff --git a/lib/test_server/test/test_server.cover b/lib/test_server/test/test_server.cover deleted file mode 100644 index 052415377d..0000000000 --- a/lib/test_server/test/test_server.cover +++ /dev/null @@ -1 +0,0 @@ -{incl_app,test_server,details}. diff --git a/lib/test_server/test/test_server.spec b/lib/test_server/test/test_server.spec deleted file mode 100644 index a3b4d01d08..0000000000 --- a/lib/test_server/test/test_server.spec +++ /dev/null @@ -1 +0,0 @@ -{suites, "../test_server_test", all}. diff --git a/lib/test_server/vsn.mk b/lib/test_server/vsn.mk deleted file mode 100644 index 3a3815c557..0000000000 --- a/lib/test_server/vsn.mk +++ /dev/null @@ -1 +0,0 @@ -TEST_SERVER_VSN = 3.9.1 diff --git a/lib/tools/Makefile b/lib/tools/Makefile index 2699ffab51..fef33743c0 100644 --- a/lib/tools/Makefile +++ b/lib/tools/Makefile @@ -24,7 +24,7 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk # Macros # ---------------------------------------------------- -SUB_DIRECTORIES = c_src src doc/src examples priv emacs +SUB_DIRECTORIES = c_src src doc/src examples emacs include vsn.mk VSN = $(TOOLS_VSN) diff --git a/lib/tools/c_src/Makefile.in b/lib/tools/c_src/Makefile.in index 66bba229f6..e8bce149b1 100644 --- a/lib/tools/c_src/Makefile.in +++ b/lib/tools/c_src/Makefile.in @@ -97,11 +97,8 @@ DRIVERS= ifneq ($(strip $(ETHR_LIB_NAME)),) # Need ethread package for emem -ifneq ($(findstring ose,$(TARGET)),ose) -# Do not build on OSE PROGS += $(BIN_DIR)/emem$(TYPEMARKER)@EXEEXT@ endif -endif EMEM_OBJ_DIR=$(OBJ_DIR)/emem CREATE_DIRS += $(EMEM_OBJ_DIR) @@ -152,12 +149,7 @@ ERTS_LIB = $(ERL_TOP/erts/lib_src/obj/$(TARGET)/$(TYPE)/MADE _create_dirs := $(shell mkdir -p $(CREATE_DIRS)) -ifneq ($(findstring ose,$(TARGET)),ose) all: $(PROGS) $(DRIVERS) -else -# Do not build dynamic files on OSE -all: -endif $(ERTS_LIB): $(make_verbose)cd $(ERL_TOP)/erts/lib_src && $(MAKE) $(TYPE) diff --git a/lib/tools/doc/src/cover_chapter.xml b/lib/tools/doc/src/cover_chapter.xml index 2f7f8d8083..c3f1570477 100644 --- a/lib/tools/doc/src/cover_chapter.xml +++ b/lib/tools/doc/src/cover_chapter.xml @@ -451,48 +451,5 @@ ok <p>When Cover is stopped, all Cover compiled modules are unloaded.</p> </section> </section> - - <section> - <title>Using the Web Based User Interface to Cover</title> - - <section> - <title>Introduction</title> - <p>To ease the use of Cover there is a web based user interface - to Cover called WebCover. WebCover is designed to be started - and used via WebTool. It is possible to Cover compile Erlang - modules and to generate printable Cover and Call analyses via - the web based user interface.</p> - </section> - - <section> - <title>Start the Web Based User Interface to Cover</title> - <p>To start WebCover you can either start WebTool, point a - browser to the start page of WebTool and start WebCover from - there, or you can use the <c>start_webtool</c> script to start - Webtool, WebCover and a browser. See WebTool documentation for - further information.</p> - <p>Currently WebCover is only compatible - with Internet Explorer and Netscape Navigator 4.0 and higher.</p> - </section> - - <section> - <title>Navigating WebCover</title> - <p>From the menu in the lefthand frame you can select the - <c>Nodes</c>, <c>Compile</c>, <c>Import</c> or <c>Result</c> - page.</p> - <p>From the <c>Nodes</c> page you can add remote nodes to - participate in the coverage analysis. Coverage data from all - involved nodes will then be merged during analysis.</p> - <p>From the <c>Compile</c> page you can Cover compile <c>.erl</c> - or <c>.beam</c> files.</p> - <p>From the <c>Import</c> page you can import coverage data from - a previous analysis. Imported data will then be merged with - the current coverage data. <em>Note</em> that it is only possible to - import files with the extension <c>.coverdata</c>.</p> - <p>From the <c>Result</c> page you can analyse, reset or export - coverage data.</p> - <p>Please follow the instructions on each page.</p> - </section> - </section> </chapter> diff --git a/lib/tools/emacs/erlang-skels-old.el b/lib/tools/emacs/erlang-skels-old.el index c271cce3cb..d0b2bfd97f 100644 --- a/lib/tools/emacs/erlang-skels-old.el +++ b/lib/tools/emacs/erlang-skels-old.el @@ -816,7 +816,7 @@ Please see the function `tempo-define-template'.") "%% Note: This directive should only be used in test suites." n "-compile(export_all)." n n - "-include_lib(\"test_server/include/test_server.hrl\")." n n + "-include_lib(\"common_test/include/ct.hrl\")." n n (erlang-skel-separator 2) "%% TEST SERVER CALLBACK FUNCTIONS" n diff --git a/lib/tools/emacs/erlang-skels.el b/lib/tools/emacs/erlang-skels.el index 6880ec733c..ac37ff2ee5 100644 --- a/lib/tools/emacs/erlang-skels.el +++ b/lib/tools/emacs/erlang-skels.el @@ -1070,7 +1070,7 @@ Please see the function `tempo-define-template'.") "%% Note: This directive should only be used in test suites." n "-compile(export_all)." n n - "-include_lib(\"test_server/include/test_server.hrl\")." n n + "-include_lib(\"common_test/include/ct.hrl\")." n n (erlang-skel-separator-start 2) "%% TEST SERVER CALLBACK FUNCTIONS" n diff --git a/lib/gs/contribs/ebin/.gitignore b/lib/tools/priv/.gitignore index e69de29bb2..e69de29bb2 100644 --- a/lib/gs/contribs/ebin/.gitignore +++ b/lib/tools/priv/.gitignore diff --git a/lib/tools/priv/Makefile b/lib/tools/priv/Makefile deleted file mode 100644 index aa4aaa2fc8..0000000000 --- a/lib/tools/priv/Makefile +++ /dev/null @@ -1,69 +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 Utvecklings AB. -# Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings -# AB. All Rights Reserved.'' -# -# $Id$ -# -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../vsn.mk -VSN = $(TOOLS_VSN) - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/tools-$(VSN) - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- - -HTDOCS_FILES = index.html - -TOOL_FILES = cover.tool - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -ERL_COMPILE_FLAGS += - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -debug opt: - -clean: - -docs: - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_spec: opt - $(INSTALL_DIR) "$(RELSYSDIR)/priv" - $(INSTALL_DATA) $(HTDOCS_FILES) "$(RELSYSDIR)/priv" - $(INSTALL_DATA) $(TOOL_FILES) "$(RELSYSDIR)/priv" - -release_docs_spec: - - - diff --git a/lib/tools/priv/cover.tool b/lib/tools/priv/cover.tool deleted file mode 100644 index 9e72f89ff4..0000000000 --- a/lib/tools/priv/cover.tool +++ /dev/null @@ -1,2 +0,0 @@ -{version,"1.2"}. -[{config_func,{cover_web,configData,[]}}]. diff --git a/lib/tools/priv/index.html b/lib/tools/priv/index.html deleted file mode 100644 index 6b60ef5d0a..0000000000 --- a/lib/tools/priv/index.html +++ /dev/null @@ -1,10 +0,0 @@ -<HTML> -<HEAD> -<TITLE>Erlang webb tools </TITLE> -</HEAD> -<FRAMESET COLS="250,*"> -<FRAME NAME="menu" SRC="/webcover/erl/cover_web/menu_frame"> -<FRAME NAME="main" SRC="/webcover/erl/cover_web/compile_frame"> -</FRAMESET> -</HTML> - diff --git a/lib/tools/src/Makefile b/lib/tools/src/Makefile index 9fcfb79628..7301ff856a 100644 --- a/lib/tools/src/Makefile +++ b/lib/tools/src/Makefile @@ -37,7 +37,6 @@ RELSYSDIR = $(RELEASE_PATH)/lib/tools-$(VSN) MODULES= \ cover \ - cover_web \ eprof \ fprof \ cprof \ diff --git a/lib/tools/src/cover.erl b/lib/tools/src/cover.erl index 366d6bcbd9..3732b0fc85 100644 --- a/lib/tools/src/cover.erl +++ b/lib/tools/src/cover.erl @@ -20,9 +20,7 @@ -module(cover). %% -%% This module implements the Erlang coverage tool. The module named -%% cover_web implements a user interface for the coverage tool to run -%% under webtool. +%% This module implements the Erlang coverage tool. %% %% ARCHITECTURE %% The coverage tool consists of one process on each node involved in @@ -1474,7 +1472,7 @@ do_compile_beam(Module,BeamFile0,State) -> {ok,Module,BeamFile}; error -> {error, BeamFile}; - {error,Reason} -> % no abstract code + {error,Reason} -> % no abstract code or no 'file' attribute {error, {Reason, BeamFile}} end; {error,no_beam} -> @@ -1537,32 +1535,11 @@ do_compile_beam1(Module,Beam,UserOptions) -> {error,E}; {raw_abstract_v1,Code} -> Forms0 = epp:interpret_file_attribute(Code), - {Forms,Vars} = transform(Forms0, Module), - - %% We need to recover the source from the compilation - %% info otherwise the newly compiled module will have - %% source pointing to the current directory - SourceInfo = get_source_info(Module, Beam), - - %% Compile and load the result - %% It's necessary to check the result of loading since it may - %% fail, for example if Module resides in a sticky directory - {ok, Module, Binary} = compile:forms(Forms, SourceInfo ++ UserOptions), - case code:load_binary(Module, ?TAG, Binary) of - {module, Module} -> - - %% Store info about all function clauses in database - InitInfo = lists:reverse(Vars#vars.init_info), - ets:insert(?COVER_CLAUSE_TABLE, {Module, InitInfo}), - - %% Store binary code so it can be loaded on remote nodes - ets:insert(?BINARY_TABLE, {Module, Binary}), - - {ok, Module}; - - _Error -> - do_clear(Module), - error + case find_main_filename(Forms0) of + {ok,MainFile} -> + do_compile_beam2(Module,Beam,UserOptions,Forms0,MainFile); + Error -> + Error end; {_VSN,_Code} -> %% Wrong version of abstract code. Just report that there @@ -1579,6 +1556,35 @@ get_abstract_code(Module, Beam) -> Error -> Error end. +do_compile_beam2(Module,Beam,UserOptions,Forms0,MainFile) -> + {Forms,Vars} = transform(Forms0, Module, MainFile), + + %% We need to recover the source from the compilation + %% info otherwise the newly compiled module will have + %% source pointing to the current directory + SourceInfo = get_source_info(Module, Beam), + + %% Compile and load the result + %% It's necessary to check the result of loading since it may + %% fail, for example if Module resides in a sticky directory + {ok, Module, Binary} = compile:forms(Forms, SourceInfo ++ UserOptions), + case code:load_binary(Module, ?TAG, Binary) of + {module, Module} -> + + %% Store info about all function clauses in database + InitInfo = lists:reverse(Vars#vars.init_info), + ets:insert(?COVER_CLAUSE_TABLE, {Module, InitInfo}), + + %% Store binary code so it can be loaded on remote nodes + ets:insert(?BINARY_TABLE, {Module, Binary}), + + {ok, Module}; + + _Error -> + do_clear(Module), + error + end. + get_source_info(Module, Beam) -> Compile = get_compile_info(Module, Beam), case lists:keyfind(source, 1, Compile) of @@ -1601,8 +1607,7 @@ get_compile_info(Module, Beam) -> [] end. -transform(Code, Module) -> - MainFile=find_main_filename(Code), +transform(Code, Module, MainFile) -> Vars0 = #vars{module=Module}, {ok,MungedForms,Vars} = transform_2(Code,[],Vars0,MainFile,on), {MungedForms,Vars}. @@ -1610,9 +1615,12 @@ transform(Code, Module) -> %% Helpfunction which returns the first found file-attribute, which can %% be interpreted as the name of the main erlang source file. find_main_filename([{attribute,_,file,{MainFile,_}}|_]) -> - MainFile; + {ok,MainFile}; find_main_filename([_|Rest]) -> - find_main_filename(Rest). + find_main_filename(Rest); +find_main_filename([]) -> + {error, no_file_attribute}. + transform_2([Form0|Forms],MungedForms,Vars,MainFile,Switch) -> Form = expand(Form0), @@ -1995,7 +2003,7 @@ munge_expr({lc,Line,Expr,Qs}, Vars) -> {{lc,Line,MungedExpr,MungedQs}, Vars3}; munge_expr({bc,Line,Expr,Qs}, Vars) -> {bin,BLine,[{bin_element,EL,Val,Sz,TSL}|Es]} = Expr, - Expr2 = {bin,BLine,[{bin_element,EL,?BLOCK1(Val),Sz,TSL}|Es]}, + Expr2 = {bin,BLine,[{bin_element,EL,Val,Sz,TSL}|Es]}, {MungedExpr,Vars2} = munge_expr(Expr2, Vars), {MungedQs, Vars3} = munge_qualifiers(Qs, Vars2), {{bc,Line,MungedExpr,MungedQs}, Vars3}; diff --git a/lib/tools/src/cover_web.erl b/lib/tools/src/cover_web.erl deleted file mode 100644 index ae8b3f25cf..0000000000 --- a/lib/tools/src/cover_web.erl +++ /dev/null @@ -1,1185 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2009. 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(cover_web). --author('[email protected]'). --behaviour(gen_server). - -%%Export of configuration function --export([configData/0]). -%% External exports --export([init/1, handle_call/3, handle_cast/2, handle_info/2, - terminate/2, code_change/3]). - --export([start_link/0,start/0,stop/0]). --export([menu_frame/2,nodes_frame/2,import_frame/2, - compile_frame/2,result_frame/2]). --export([list_dir/2,compile/2,add_node/2,remove_node/2,result/2, - calls/2,coverage/2,import/2]). - --record(state,{dir}). - --include_lib("kernel/include/file.hrl"). - -%% Timeouts --define(DEFAULT_TIME,10000). --define(MAX_COMPILE_TIME,60000). --define(MAX_ANALYSE_TIME,30000). - -%% Colors --define(INFO_BG_COLOR,"#C0C0EA"). - -%%%---------------------------------------------------------------------- -%%% API - called from erlang shell -%%%---------------------------------------------------------------------- -%% Start webtool and webcover from erlang shell -start() -> - webtool:start(), - webtool:start_tools([],"app=webcover"), - ok. - -%% Stop webtool and webcover from erlang shell -stop() -> - webtool:stop_tools([],"app=webcover"), - webtool:stop(). - - - -%%%---------------------------------------------------------------------- -%%% API - called from webtool -%%%---------------------------------------------------------------------- -start_link() -> - gen_server:start_link({local, webcover_server},cover_web, [], []). - - -nodes_frame(Env,Input)-> - call({nodes_frame,Env,Input}). - -add_node(Env,Input)-> - call({add_node,Env,Input}). - -remove_node(Env,Input)-> - call({remove_node,Env,Input}). - -compile_frame(Env,Input)-> - call({compile_frame,Env,Input}). - -list_dir(Env,Input) -> - call({list_dir,Env,Input}). - -compile(Env,Input)-> - call({compile,Env,Input},?MAX_COMPILE_TIME). - -result_frame(Env,Input)-> - call({result_frame,Env,Input}). - -result(Env,Input) -> - call({result,Env,Input},?MAX_ANALYSE_TIME). - -calls(Env,Input) -> - call({calls,Env,Input}). - -coverage(Env,Input) -> - call({coverage,Env,Input}). - -import_frame(Env,Input)-> - call({import_frame,Env,Input}). - -import(Env,Input)-> - call({import,Env,Input}). - -menu_frame(Env,Input)-> - call({menu_frame,Env,Input}). - -call(Msg) -> - call(Msg,?DEFAULT_TIME). -call(Msg,Time) -> - gen_server:call(webcover_server,Msg,Time). - - - -configData()-> - {webcover,[{web_data,{"WebCover","/webcover"}}, - {alias,{"/webcover",code:priv_dir(tools)}}, - {alias,{erl_alias,"/webcover/erl",[cover_web]}}, - {start,{child,{{local,webcover_server}, - {cover_web,start_link,[]}, - permanent,100,worker,[cover_web]}}} - ]}. - - -%%%---------------------------------------------------------------------- -%%% Callback functions from gen_server -%%%---------------------------------------------------------------------- - -%%---------------------------------------------------------------------- -%% Func: init/1 -%% Returns: {ok, State} | -%% {ok, State, Timeout} | -%% ignore | -%% {stop, Reason} -%%---------------------------------------------------------------------- -init([]) -> - cover:start(), - CS = whereis(cover_server), - link(CS), - GL = spawn_link(fun group_leader_proc/0), - group_leader(GL,CS), - - %% Must trap exists in order to have terminate/2 executed when - %% crashing because of a linked process crash. - process_flag(trap_exit,true), - {ok,Cwd} = file:get_cwd(), - {ok, #state{dir=Cwd}}. - -group_leader_proc() -> - register(cover_group_leader_proc,self()), - group_leader_loop([]). -group_leader_loop(Warnings) -> - receive - {io_request,From,ReplyAs,{put_chars,io_lib,Func,[Format,Args]}} -> - Msg = (catch io_lib:Func(Format,Args)), - From ! {io_reply,ReplyAs,ok}, - case lists:member(Msg,Warnings) of - true -> group_leader_loop(Warnings); - false -> group_leader_loop([Msg|Warnings]) - end; - {io_request,From,ReplyAs,{put_chars,_Encoding,io_lib,Func,[Format,Args]}} -> - Msg = (catch io_lib:Func(Format,Args)), - From ! {io_reply,ReplyAs,ok}, - case lists:member(Msg,Warnings) of - true -> group_leader_loop(Warnings); - false -> group_leader_loop([Msg|Warnings]) - end; - IoReq when element(1,IoReq)=:= io_request -> - group_leader() ! IoReq, - group_leader_loop(Warnings); - {From,get_warnings} -> - Warnings1 = - receive - {io_request,From,ReplyAs, - {put_chars,io_lib,Func,[Format,Args]}} -> - Msg = (catch io_lib:Func(Format,Args)), - From ! {io_reply,ReplyAs,ok}, - case lists:member(Msg,Warnings) of - true -> Warnings; - false -> [Msg|Warnings] - end - after 0 -> - Warnings - end, - From ! {warnings,Warnings1}, - group_leader_loop([]) - end. - -%%---------------------------------------------------------------------- -%% Func: handle_call/3 -%% Returns: {reply, Reply, State} | -%% {reply, Reply, State, Timeout} | -%% {noreply, State} | -%% {noreply, State, Timeout} | -%% {stop, Reason, Reply, State} | (terminate/2 is called) -%% {stop, Reason, State} (terminate/2 is called) -%%---------------------------------------------------------------------- -handle_call({nodes_frame,_Env,_Input},_From,State)-> - {reply,nodes_frame1(),State}; - -handle_call({add_node,_Env,Input},_From,State)-> - {reply,do_add_node(Input),State}; - -handle_call({remove_node,_Env,Input},_From,State)-> - {reply,do_remove_node(Input),State}; - -handle_call({compile_frame,_Env,_Input},_From,State)-> - {reply,compile_frame1(State#state.dir),State}; - -handle_call({list_dir,_Env,Input},_From,State)-> - Dir = get_input_data(Input,"path"), - case filelib:is_dir(Dir) of - true -> - {reply,compile_frame1(Dir),State#state{dir=Dir}}; - false -> - Err = Dir ++ " is not a directory", - {reply,compile_frame1(State#state.dir,Err),State} - end; -handle_call({compile,_Env,Input},_From,State)-> - {reply,do_compile(Input,State#state.dir),State}; - -handle_call({result_frame,_Env,_Input},_From,State)-> - {reply,result_frame1(),State}; - -handle_call({result,_Env,Input},_From,State)-> - {reply,handle_result(Input),State}; - -handle_call({calls,_Env,Input},_From,State)-> - {reply,call_page(Input),State}; - -handle_call({coverage,_Env,Input},_From,State)-> - {reply,coverage_page(Input),State}; - -handle_call({import_frame,_Env,_Input},_From,State)-> - {ok,Cwd} = file:get_cwd(), - {reply,import_frame1(Cwd),State}; - -handle_call({import,_Env,Input},_From,State)-> - {reply,do_import(Input),State}; - -handle_call({menu_frame,_Env,_Input},_From,State)-> - {reply,menu_frame1(),State}; - -handle_call(_Request, _From, State) -> - Reply = bad_request, - {reply, Reply, State}. - - -%%---------------------------------------------------------------------- -%% Func: handle_cast/2 -%% Returns: {noreply, State} | -%% {noreply, State, Timeout} | -%% {stop, Reason, State} (terminate/2 is called) -%%---------------------------------------------------------------------- -handle_cast(_Msg, State) -> - {noreply, State}. - -%%---------------------------------------------------------------------- -%% Func: handle_info/2 -%% Returns: {noreply, State} | -%% {noreply, State, Timeout} | -%% {stop, Reason, State} (terminate/2 is called) -%%---------------------------------------------------------------------- -handle_info({'EXIT',_Pid,Reason}, State) -> - {stop, Reason, State}. - -%%---------------------------------------------------------------------- -%% Func: terminate/2 -%% Purpose: Shutdown the server -%% Returns: any (ignored by gen_server) -%%---------------------------------------------------------------------- -terminate(_Reason, _State) -> - cover:stop(), - ok. - -%%-------------------------------------------------------------------- -%% Func: code_change/3 -%% Purpose: Convert process state when code is changed -%% Returns: {ok, NewState} -%%-------------------------------------------------------------------- -code_change(_OldVsn, State, _Extra) -> - {ok, State}. - -%%%---------------------------------------------------------------------- -%%% Internal functions -%%%---------------------------------------------------------------------- - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% The functions that creates the whole pages by collecting all the %% -%% neccessary data for each page. These functions are the public %% -%% interface. %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%---------------------------------------------------------------------- -%% Returns the page to the left frame -%%---------------------------------------------------------------------- -menu_frame1()-> - [header(),html_header(""),menu_body(),html_end()]. - -%%---------------------------------------------------------------------- -%% Creates the page where the user can add and remove nodes -%%---------------------------------------------------------------------- - -nodes_frame1()-> - nodes_frame1([]). -nodes_frame1(Err)-> - [header(),html_header("Add/remove nodes"),nodes_body(Err),html_end()]. - -%%---------------------------------------------------------------------- -%% Creates the page where the user can cover compile modules -%%---------------------------------------------------------------------- - -compile_frame1(Dir)-> - compile_frame1(Dir,[]). -compile_frame1(Dir,Err) -> - [header(),html_header("Cover compile"),compile_body(Dir,Err),html_end()]. - -%%---------------------------------------------------------------------- -%% Creates the page where the user can handle results -%%---------------------------------------------------------------------- - -result_frame1()-> - result_frame1([]). -result_frame1(Err) -> - [header(),html_header("Show cover results"),result_body(Err),html_end()]. - -%%---------------------------------------------------------------------- -%%The beginning of the page that clear the cover information on a cover -%%compiled module -%%---------------------------------------------------------------------- -call_page(Input)-> - [header(),html_header("Code coverage"),call_result(Input),html_end()]. - -coverage_page(Input)-> - [header(),html_header("Code coverage"),coverage_result(Input),html_end()]. - -%%---------------------------------------------------------------------- -%% Creates the page where the user an import files -%%---------------------------------------------------------------------- -import_frame1(Dir) -> - import_frame1(Dir,""). -import_frame1(Dir,Err) -> - [header(),html_header("Import coverdata"),import_body(Dir,Err),html_end()]. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% The functions that build the body of the menu frame %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -menu_body() -> - Nodes = cover:which_nodes(), - Modules = cover:modules(), - Imported = cover:imported(), - ["<A HREF=\"./nodes_frame\" TARGET=\"main\">Nodes</A><BR>\n", - "<A HREF=\"./compile_frame\" TARGET=\"main\">Compile</A><BR>\n", - "<A HREF=\"./import_frame\" TARGET=\"main\">Import</A><BR>\n", - "<A HREF=\"./result_frame\" TARGET=\"main\">Result</A>\n", - "<P><B>Nodes:</B>\n", - "<UL>\n", - lists:map(fun(N) -> "<LI>"++atom_to_list(N)++"</LI>\n" end,[node()|Nodes]), - "</UL>\n", - "<P><B>Compiled modules:</B>\n", - "<UL>\n", - lists:map(fun(M) -> "<LI>"++atom_to_list(M)++"</LI>\n" end,Modules), - "</UL>\n", - "<P><B>Imported files:</B>\n", - "<UL>\n", - "<FONT SIZE=-1>\n", - lists:map(fun(F) -> - Short = filename:basename(F), - "<LI TITLE=\""++F++"\">"++Short++"</LI>\n" end,Imported), - "</FONT>\n", - "</UL>\n"]. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% The functions that build the body of the nodes frame %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -nodes_body(Err) -> - CN = cover:which_nodes(), - Fun = fun(N) -> - NStr = atom_to_list(N), - ["<OPTION VALUE=",NStr, - " onClick=\"node.value=selected_node.value\">",NStr, - "</OPTION>\n"] - end, - AllNodes = lists:append(lists:map(Fun,nodes()--CN)), - CoverNodes = lists:append(lists:map(Fun,CN)), - - [reload_menu_script(Err), - "<H1 ALIGN=center>Nodes</H1>\n", - "<TABLE BORDER=0 WIDTH=600 ALIGN=center>\n", - "<TR><TD BGCOLOR=",?INFO_BG_COLOR," COLSPAN=2>\n", - "<P>You can run cover over several nodes simultaneously. Coverage data\n", - "from all involved nodes will be merged during analysis.\n", - "<P>Select or enter node names to add or remove here.\n", - "</TD></TR>\n", - "<TR><TD COLSPAN=2><BR><BR></TD></TR>\n", - "<FORM ACTION=\"./add_node\" NAME=add_node>\n", - "<TR><TD VALIGN=top>Add node:</TD>\n", - "<TD><INPUT TYPE=text NAME=\"node\" SIZE=40 >", - "<INPUT TYPE=submit\n", - " onClick=\"if(!node.value){node.value=selected_node.value};\" VALUE=Add>" - "<BR><SELECT NAME=selected_node TITLE=\"Select node\">\n", - AllNodes ++ - "</SELECT>\n", - "</TD></TR>\n" - "</FORM>\n", - "<TR><TD COLSPAN=2><BR><BR></TD></TR>\n", - "<FORM ACTION=\"./remove_node\" NAME=remove_node>\n", - "<TR><TD>Remove node:</TD>\n", - "<TD><SELECT NAME=node TITLE=\"Select node\">\n", - CoverNodes ++ - "</SELECT>\n", - "<INPUT TYPE=submit VALUE=Remove>" - "</TD></TR>\n", - "</FORM>", - "</TABLE>"]. - - -do_add_node(Input) -> - NodeStr = get_input_data(Input, "node"), - Node = list_to_atom(NodeStr), - case net_adm:ping(Node) of - pong -> - cover:start(Node), - nodes_frame1(); - pang -> - nodes_frame1("Node \\\'" ++ NodeStr ++ "\\\' is not alive") - end. - -do_remove_node(Input) -> - Node = list_to_atom(get_input_data(Input, "node")), - cover:stop(Node), - nodes_frame1(). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% % -% The functions that is used when the user wants to compile something % -% % -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -compile_body(Dir,Err) -> - Erls = filelib:wildcard(filename:join(Dir,"*.erl")), - Beams = filelib:wildcard(filename:join(Dir,"*.beam")), - - [reload_menu_script(Err), - "<H1 ALIGN=center>Compile</H1>\n", - "<TABLE WIDTH=600 ALIGN=center BORDER=0>\n", - "<TR><TD COLSPAN=3 BGCOLOR=",?INFO_BG_COLOR,">\n", - "Each module which shall be part of the cover analysis must be prepared\n", - "or 'cover compiled'. On this page you can select .erl files and/or\n", - ".beam files to include in the analysis. If you select a .erl file it\n", - "will first be compiled with the Erlang compiler and then prepared for\n", - "coverage analysis. If you select a .beam file it will be prepared for\n", - "coverage analysis directly.\n", - "</TD></TR>\n", - "<FORM ACTION=\"./list_dir\" NAME=list_dir>\n", - "<TR><TD WIDTH=30% BGCOLOR=",?INFO_BG_COLOR," ROWSPAN=2>\n", - "To list a different directory, enter the directory name here.\n", - "</TD>\n", - "<TH COLSPAN=2><BR>List directory:<BR></TH>\n", - "</TR>\n", - "<TR><TD ALIGN=center COLSPAN=2>\n", - "<INPUT TYPE=text NAME=\"path\" SIZE=40 VALUE=",Dir,">", - "<INPUT TYPE=submit VALUE=Ok>", - "<BR><BR></TD></TR>\n", - "</FORM>\n", - "<FORM ACTION=\"./compile\" NAME=compile_selection>\n", - "<TR><TD BGCOLOR=",?INFO_BG_COLOR," ROWSPAN=2>\n", - "<P>Select one or more .erl or .beam files to prepare for coverage\n" - "analysis, and click the \"Compile\" button.\n", - "<P>To reload the original file after coverage analysis is complete,\n" - "select one or more files and click the \"Uncompile\" button, or\n", - "simply click the \"Uncompile all\" button to reload all originals.\n" - "</TD>\n", - "<TH>.erl files</TH><TH>.beam files</TH></TR>\n", - "<TR><TD ALIGN=center VALIGN=top>\n", - "<SELECT NAME=erl TITLE=\"Select .erl files to compile\" MULTIPLE=true", - " SIZE=15>\n", - list_modules(Erls) ++ - "</SELECT></TD>\n", - "<TD ALIGN=center VALIGN=top>\n", - "<SELECT NAME=beam TITLE=\"Select .beam files to compile\"MULTIPLE=true", - " SIZE=15>\n", - list_modules(Beams) ++ - "</SELECT></TD></TR>\n" - "<TR><TD BGCOLOR=",?INFO_BG_COLOR," ROWSPAN=2>\n", - "Compile options are only needed for .erl files. The options must be\n" - "given e.g. like this: \n" - "<FONT SIZE=-1>[{i,\"/my/path/include\"},{i,\"/other/path/\"}]</FONT>\n" - "</TD>\n", - "<TH COLSPAN=2><BR>Compile options:<BR></TH>\n", - "</TR>\n", - "<TR><TD COLSPAN=2 ALIGN=center>\n", - "<INPUT TYPE=text NAME=\"options\" SIZE=40>\n", - "<INPUT TYPE=hidden NAME=\"action\"></TD></TR>\n", - "<TR><TD></TD><TD ALIGN=center COLSPAN=2>\n", - "<INPUT TYPE=submit onClick=\"action.value=\'compile\';\"VALUE=Compile>", - "<INPUT TYPE=submit onClick=\"action.value=\'uncompile\';\" ", - "VALUE=Uncompile>", - "<INPUT TYPE=submit onClick=\"action.value=\'uncompile_all\';\" ", - "VALUE=\"Uncompile all\">", - "<BR><INPUT TYPE=reset VALUE=\"Reset form\"></TD></TR>\n", - "</FORM>\n", - "</TABLE>\n"]. - -list_modules([File|Files]) -> - Mod = filename:basename(File), - ["<OPTION VALUE=",File," onDblClick=\"action.value=\'compile\';submit();\">", - Mod,"</OPTION>\n" | list_modules(Files)]; -list_modules([]) -> - []. - -do_compile(Input,Dir) -> - {Erls,Beams,Opts,Action} = get_compile_input(parse(Input),[],[]), - Errs = - case Action of - "compile" -> - do_compile(Erls,Beams,Opts,[]); - "uncompile" -> - do_uncompile(Erls++Beams); - "uncompile_all" -> - do_uncompile(cover:modules()) - end, - compile_frame1(Dir,Errs). - -get_compile_input([{"erl",File}|Input],Erl,Beam) -> - get_compile_input(Input,[File|Erl],Beam); -get_compile_input([{"beam",File}|Input],Erl,Beam) -> - get_compile_input(Input,Erl,[File|Beam]); -get_compile_input([{"options",Opts0},{"action",Action}],Erl,Beam) -> - Opts = parse_options(Opts0), - {Erl,Beam,Opts,Action}. - -do_compile([Erl|Erls],Beams,Opts,Errs) -> - case cover:compile_module(Erl,Opts) of - {ok,_} -> - do_compile(Erls,Beams,Opts,Errs); - {error,File} -> - do_compile(Erls,Beams,Opts,["\\n"++File|Errs]) - end; -do_compile([],[Beam|Beams],Opts,Errs) -> - case cover:compile_beam(Beam) of - {ok,_} -> - do_compile([],Beams,Opts,Errs); - {error,{no_abstract_code,File}} -> - do_compile([],Beams,Opts,["\\n"++File++" (no_abstract_code)"|Errs]) - end; -do_compile([],[],_,[]) -> - []; -do_compile([],[],_,Errs) -> - "Compilation failed for the following files:" ++ Errs. - -parse_options(Options)-> - case erl_scan:string(Options ++".") of - {ok,Tokens,_Line} -> - case erl_parse:parse_exprs(Tokens) of - {ok,X}-> - case lists:map(fun erl_parse:normalise/1, X) of - [List] when is_list(List) -> List; - List -> List - end; - _ -> - [] - end; - _ -> - [] - end. - - -do_uncompile(Files) -> - lists:foreach( - fun(File) -> - Module = - if is_atom(File) -> - File; - true -> - ModStr = filename:basename(filename:rootname(File)), - list_to_atom(ModStr) - end, - case code:which(Module) of - cover_compiled -> - code:purge(Module), - case code:load_file(Module) of - {module, Module} -> - ok; - {error, _Reason2} -> - code:delete(Module) - end; - _ -> - ok - end - end, - Files), - []. - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% % -% The functions that builds the body of the page for coverage analysis% -% % -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -result_body(Err) -> - [reload_menu_script(Err), - "<H1 ALIGN=center>Result</H1>\n", - "<TABLE BORDER=0 WIDTH=600 ALIGN=center>\n", - "<TR><TD BGCOLOR=",?INFO_BG_COLOR,">\n", - "<P>After executing all your tests you can view the result of the\n", - "coverage analysis here. For each module you can\n", - "<DL>\n", - "<DT><B>Analyse to file</B></DT>\n", - "<DD>The source code of the module is shown with the number of calls\n", - "to each line stated in the left margin. Lines which are never called\n", - "are colored red.</DD>\n", - "<DT><B>Analyse coverage</B></DT>\n", - "<DD>Show the number of covered and uncovered lines in the module.</DD>\n", - "<DT><B>Analyse calls</B></DT>\n", - "<DD>Show the number of calls in the module.</DD>\n", - "<DT><B>Reset module</B></DT>\n", - "<DD>Delete all coverage data for the module.</DD>\n", - "<DT><B>Export module</B></DT>\n", - "<DD>Write all coverage data for the module to a file. The data can\n", - "later be imported from the \"Import\" page.</DD>\n", - "</DL>\n", - "<P>You can also reset or export data for all modules with the\n", - "<B>Reset all</B> and <B>Export all</B> actions respectively. For these\n", - "two actions there is no need to select a module.\n", - "<P>Select module and action from the drop down menus below, and click\n", - "the \"Execute\" button.\n", - "</TD></TR>\n", - "<TR><TD><BR><BR>\n", - result_selections(), - "</TD></TR></TABLE>"]. - -result_selections() -> - ModList = filter_modlist(cover:modules()++cover:imported_modules(),[]), - - ["<FORM ACTION=\"./result\" NAME=result_selection>\n", - "<TABLE WIDTH=\"300\" BORDER=0 ALIGN=center>\n", - "<TR><TD ALIGN=left>\n", - "Module:\n", - "<BR><SELECT NAME=module TITLE=\"Select module\">\n", - ModList ++ - "</SELECT>\n", - "</TD>\n", - "<TD ALIGN=left>\n", - "Action:\n", - "<BR><SELECT NAME=action TITLE=\"Select action\">\n", - "<OPTION VALUE=\"analyse_to_file\">Analyse to file</OPTION>\n" - "<OPTION VALUE=\"coverage\">Analyse coverage</OPTION>\n" - "<OPTION VALUE=\"calls\">Analyse calls</OPTION>\n" - "<OPTION VALUE=\"reset\">Reset module</OPTION>\n" - "<OPTION VALUE=\"reset_all\">Reset all</OPTION>\n" - "<OPTION VALUE=\"export\">Export module</OPTION>\n" - "<OPTION VALUE=\"export_all\">Export all</OPTION>\n" - "</SELECT>\n", - "</TD>\n", - "<TD ALIGN=center VALIGN=bottom><INPUT TYPE=submit VALUE=Execute>\n" - "</TD></TR>\n" - "</TABLE>\n", - "</FORM>\n"]. - -filter_modlist([M|Ms],Already) -> - case lists:member(M,Already) of - true -> - filter_modlist(Ms,Already); - false -> - MStr = atom_to_list(M), - ["<OPTION VALUE=",MStr,">",MStr,"</OPTION>\n" | - filter_modlist(Ms,[M|Already])] - end; -filter_modlist([],_Already) -> - []. - - - -handle_result(Input) -> - case parse(Input) of - [{"module",M},{"action",A}] -> - case A of - "analyse_to_file" -> - case cover:analyse_to_file(list_to_atom(M),[html]) of - {ok,File} -> - case file:read_file(File) of - {ok,HTML}-> - file:delete(File), - [header(), - reload_menu_script(""), - binary_to_list(HTML)]; - _ -> - result_frame1("Can not read file" ++ File) - end; - {error,no_source_code_found} -> - result_frame1("No source code found for \\\'" ++ - M ++ "\\\'") - end; - "calls" -> - call_page(Input); - "coverage" -> - coverage_page(Input); - "reset" -> - cover:reset(list_to_atom(M)), - result_frame1("Coverage data for \\\'" ++ M ++ - "\\\' is now reset"); - "reset_all" -> - cover:reset(), - result_frame1("All coverage data is now reset"); - "export" -> - ExportFile = generate_filename(M), - cover:export(ExportFile,list_to_atom(M)), - result_frame1("Coverage data for \\\'" ++ M ++ - "\\\' is now exported to file \\\"" ++ - ExportFile ++ "\\\""); - "export_all" -> - ExportFile = generate_filename("COVER"), - cover:export(ExportFile), - result_frame1( - "All coverage data is now exported to file \\\"" ++ - ExportFile ++ "\\\"") - end; - [{"action",_A}] -> - result_frame1("No module is selected") - end. - -generate_filename(Prefix) -> - {ok,Cwd} = file:get_cwd(), - filename:join(Cwd,Prefix ++ "_" ++ ts() ++ ".coverdata"). - -ts() -> - {{Y,M,D},{H,Min,S}} = calendar:now_to_local_time(erlang:timestamp()), - io_lib:format("~4.4.0w~2.2.0w~2.2.0w-~2.2.0w~2.2.0w~2.2.0w", - [Y,M,D,H,Min,S]). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% % -% The functions that builds the body of the page that shows the calls % -% % -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -call_result(Input)-> - Mod = list_to_atom(get_input_data(Input, "module")), - case cover:analyse(Mod,calls) of - {error,_}-> - error_body(); - {ok,_} -> - call_result2(Mod,Input) - end. - -call_result2(Mod,Input)-> - Result = - case get_input_data(Input,"what") of - "mod" -> - call_result(mod,Mod); - "func" -> - call_result(func,Mod); - "clause" -> - call_result(clause,Mod); - _-> - call_result(all,Mod) - end, - result_choice("calls",Mod) ++ Result. - -result_choice(Level,Mod)-> - ModStr=atom_to_list(Mod), - [reload_menu_script(""), - "<TABLE WIDTH=100%><TR>\n", - "<TD><A HREF=./",Level,"?module=",ModStr,"&what=all>All Data</A></TD>\n", - "<TD><A HREF=./",Level,"?module=",ModStr,"&what=mod>Module</A></TD>\n", - "<TD><A HREF=./",Level,"?module=",ModStr,"&what=func>Function</A></TD>\n", - "<TD><A HREF=./",Level,"?module=",ModStr,"&what=clause>Clause</A></TD>\n", - "</TR></TABLE><BR>\n"]. - -call_result(Mode,Module)-> - Content = - case Mode of - mod-> - format_cover_call(cover:analyse(Module,calls,module),mod); - func-> - format_cover_call(cover:analyse(Module,calls,function),func); - clause-> - format_cover_call(cover:analyse(Module,calls,clause),clause); - _-> - format_cover_call(cover:analyse(Module,calls,module),mod) ++ - format_cover_call(cover:analyse(Module,calls,function),func)++ - format_cover_call(cover:analyse(Module,calls,clause),clause) - end, - getModDate(Module,date())++"<BR>"++ - "<TABLE WIDTH=\"100%\" BORDER=1>" - ++ Content ++"</TABLE>". - - -format_cover_call({error,_},_)-> - ["<TR><TD>\n", - "<BR><BR><BR><BR>\n", - "<FONT SIZE=5>The selected module is not Cover Compiled</FONT>\n", - "<BR>\n", - "</TD></TR>\n"]; - -format_cover_call({ok,{Mod,Calls}},mod)-> - ["<TR BGCOLOR=\"#8899AA\"><TD COLSPAN=5><B>Module calls</B></TD></TR>\n", - "<TR><TD COLSPAN=4><I>Module</I></TD>", - "<TD ALIGN=\"right\"><I>Number of calls</I></TD></TR>\n", - "<TR><TD COLSPAN=4>" ++ atom_to_list(Mod) ++"</TD>" - "<TD ALIGN=\"right\">" ++ integer_to_list(Calls)++"</TD></TR>\n"]; - -format_cover_call({ok,Calls},func)-> - ["<TR BGCOLOR=\"#8899AA\"><TD COLSPAN=5><B>Function calls</B></TD></TR>\n", - "<TR><TD><I>Module</I></TD><TD><I>Function</I></TD>", - "<TD COLSPAN=2 ALIGN=\"right\"><I>Arity</I></TD>", - "<TD ALIGN=\"right\"><I>Number of calls </I></TD></TR>\n", - lists:append( - lists:map( - fun({{Mod,Func,Arity},Nr_of_calls})-> - ["<TR><TD WIDTH=\"20%\">"++ atom_to_list(Mod)++"</TD>\n", - "<TD WIDTH=\"20%\" >" ++ atom_to_list(Func) ++" </TD>\n", - "<TD COLSPAN=2 WIDTH=\"40%\" ALIGN=\"right\">", - integer_to_list(Arity), - "</TD>\n", - "<TD WIDTH=\"20%\" ALIGN=\"right\">", - integer_to_list(Nr_of_calls), - "</TD></TR>\n"] - end, - Calls))]; - -format_cover_call({ok,Calls},clause)-> - ["<TR BGCOLOR=\"#8899AA\"><TD COLSPAN=5><B>Clause calls</B></TD></TR>\n", - "<TR><TD><I>Module</I></TD><TD><I>Function</I></TD>", - "<TD ALIGN=\"right\"><I>Arity</I></TD>", - "<TD ALIGN=\"right\"><I>Ordinal</I></TD>", - "<TD ALIGN=\"right\"><I>Number of calls</I></TD></TR>\n", - lists:append( - lists:map( - fun({{Mod,Func,Arity,Ord},Nr_of_calls})-> - ["<TR><TD WIDTH=\"20%\" >", atom_to_list(Mod), "</TD>\n", - "<TD WIDTH=\"20%\" >", atom_to_list(Func), "</TD>\n", - "<TD WIDTH=\"20%\" ALIGN=\"right\">", - integer_to_list(Arity), - "</TD>\n", - "<TD WIDTH=\"20%\" ALIGN=\"right\">", - integer_to_list(Ord), - "</TD>\n", - "<TD WIDTH=\"20%\" ALIGN=\"right\">", - integer_to_list(Nr_of_calls), - "</TD></TR>\n"] - end, - Calls))]. - - -error_body()-> - ["<TABLE WIDTH=\"100%\" BORDER=1>\n", - "<TR ALIGN=\"center\">\n", - "<TD>\n", - "<BR><BR><BR><BR><BR><BR>\n", - "<FONT SIZE=5>The selected module is not Cover Compiled</FONT>\n", - "<BR>\n", - "</TD>\n", - "</TR>\n", - "</TABLE>\n"]. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% % -% The functions that builds the body of the page that shows coverage % -% % -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -coverage_result(Input)-> - Mod = list_to_atom(get_input_data(Input, "module")), - case cover:analyse(Mod,coverage) of - {error,_}-> - error_body(); - {ok,_} -> - coverage_result2(Mod,Input) - end. - -coverage_result2(Mod,Input)-> - Result = - case get_input_data(Input,"what") of - "mod" -> - coverage_result(mod,Mod); - "func" -> - coverage_result(func,Mod); - "clause" -> - coverage_result(clause,Mod); - _-> - coverage_result(all,Mod) - end, - result_choice("coverage",Mod) ++ Result. - -coverage_result(Mode,Module)-> - Content = - case Mode of - mod-> - format_cover_coverage(cover:analyse(Module,coverage,module), - mod); - func-> - format_cover_coverage(cover:analyse(Module,coverage,function), - func); - clause-> - format_cover_coverage(cover:analyse(Module,coverage,clause), - clause); - _-> - format_cover_coverage(cover:analyse(Module,coverage,module), - mod) ++ - format_cover_coverage(cover:analyse(Module,coverage,function), - func)++ - format_cover_coverage(cover:analyse(Module,coverage,clause), - clause) - end, - getModDate(Module,date())++"<BR>"++ - "<TABLE WIDTH=\"100%\" BORDER=1>" - ++ Content ++"</TABLE>". - -getModDate(Module,{Year,Mon,Day})-> - "<TABLE> - <TR> - <TD>Module:</TD> - <TD>" ++ atom_to_list(Module) ++ "</TD> - </TR> - <TR> - <TD>Date:</TD> - <TD>" ++ integer_to_list(Day) ++ "/" ++ - integer_to_list(Mon) ++" - "++ - integer_to_list(Year) ++ - "</TD> - </TR> - </TABLE>". - - -format_cover_coverage({error,_},_)-> - "<TR><TD> - <BR><BR><BR><BR> - <FONT SIZE=5>The selected module is not Cover Compiled</FONT> - <BR> - </TD></TR>"; - - -format_cover_coverage({ok,{Mod,{Cov,Not_cov}}},mod)-> - ["<TR BGCOLOR=\"#8899AA\"><TD COLSPAN=6><B>Module coverage</B></TD></TR>\n", - "<TR><TD COLSPAN=4><I>Module</I></TD>\n", - "<TD ALIGN=\"right\"><I>Covered</I></TD>\n" - "<TD ALIGN=\"RIGHT\" NOWRAP=\"true\"><I>Not Covered</I></TD>\n", - "</TR>\n", - "<TR><TD COLSPAN=4>", atom_to_list(Mod), "</TD>\n" - "<TD ALIGN=\"right\">", integer_to_list(Cov), "</TD>\n" - "<TD ALIGN=\"right\" >", integer_to_list(Not_cov), "</TD></TR>\n"]; - -format_cover_coverage({ok,Cov_res},func)-> - ["<TR BGCOLOR=\"#8899AA\"><TD COLSPAN=6><B>Function coverage</B></TD>\n", - "</TR>\n", - "<TR><TD><I>Module</I></TD><TD><I>Function</I></TD>", - "<TD ALIGN=\"right\"><I>Arity</I></TD>", - "<TD COLSPAN=2 ALIGN=\"right\"><I>Covered</I></TD>", - "<TD ALIGN=\"right\" STYLE=\"white-space:nowrap\"><I>Not Covered</I></TD>", - "</TR>\n", - lists:append( - lists:map( - fun({{Mod,Func,Arity},{Cov,Not_cov}})-> - ["<TR><TD WIDTH=\"20%\" >"++ atom_to_list(Mod) ++" </TD>\n", - "<TD WIDTH=\"20%\" >" ++ atom_to_list(Func) ++"</TD>\n", - "<TD WIDTH=\"40%\" ALIGN=\"right\">", - integer_to_list(Arity), - "</TD>\n", - "<TD WIDTH=\"40%\" ALIGN=\"right\" COLSPAN=2>", - integer_to_list(Cov), - "</TD>\n" - "<TD WIDTH=\"20%\" ALIGN=\"right\">", - integer_to_list(Not_cov), - "</TD></TR>\n"] - end, - Cov_res))]; - -format_cover_coverage({ok,Cov_res},clause)-> - ["<TR BGCOLOR=\"#8899AA\"><TD COLSPAN=6><B>Clause coverage</B></TD></TR>\n", - "<TR><TD><I>Module</I></TD><TD><I>Function</I></TD>\n", - "<TD ALIGN=\"right\"><I>Arity</I></TD>\n", - "<TD ALIGN=\"right\"><I>Ordinal<I></TD>\n", - "<TD ALIGN=\"right\">Covered</TD>\n", - "<TD ALIGN=\"right\" STYLE=\"white-space:nowrap\">Not Covered</TD></TR>\n", - lists:append( - lists:map( - fun({{Mod,Func,Arity,Ord},{Cov,Not_cov}})-> - ["<TR><TD WIDTH=\"20%\" >"++ atom_to_list(Mod) ++"</TD>\n", - "<TD WIDTH=\"20%\" >" ++ atom_to_list(Func) ++" </TD>\n", - "<TD WIDTH=\"20%\" ALIGN=\"right\">", - integer_to_list(Arity), - "</TD>\n" - "<TD WIDTH=\"20%\" ALIGN=\"right\">", - integer_to_list(Ord), - "</TD>\n" - "<TD WIDTH=\"20%\" ALIGN=\"right\">", - integer_to_list(Cov), - "</TD>\n" - "<TD WIDTH=\"20%\" ALIGN=\"right\">", - integer_to_list(Not_cov), - "</TD></TR>\n"] - end, - Cov_res))]. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% % -% The functions that builds the body of the import page % -% % -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -import_body(Dir,Err) -> - [reload_menu_script(Err), - "<H1 ALIGN=center>Import</H1>\n", - "<TABLE BORDER=0 WIDTH=600 ALIGN=center>\n", - "<TR><TD BGCOLOR=",?INFO_BG_COLOR,">\n", - "<P>You can import coverage data from a previous analysis. If you do so\n", - "the imported data will be merged with the current coverage data.\n", - "<P>You can export data from the current analysis from the \"Result\"\n", - "page.\n", - "<P>Select the file to import here.\n", - "</TD></TR>\n", - "<TR><TD ALIGN=center><BR><BR>\n", - "<FORM NAME=change_import_dir METHOD=post ACTION=\"./import\">\n", - "<B>Change directory:</B><BR>\n", - "<INPUT TYPE=text NAME=\"file\" SIZE=30 VALUE=",Dir,">", - "<INPUT TYPE=hidden NAME=dir VALUE=",Dir,">\n", - "<INPUT TYPE=submit VALUE=Ok><BR>\n", - "</FORM>\n", - browse_import(Dir), - "</TABLE>"]. - -browse_import(Dir) -> - {ok,List} = file:list_dir(Dir), - Sorted = lists:reverse(lists:sort(List)), - {Dirs,Files} = filter_files(Dir,Sorted,[],[]), - ["<FORM NAME=browse_import METHOD=post ACTION=\"./import\">\n" - "<SELECT NAME=file TITLE=\"Select import file\" SIZE=10>\n", - "<OPTION VALUE=\"..\" onDblClick=submit()>../</OPTION>\n", - Dirs, - Files, - "</SELECT>\n", - "<INPUT TYPE=hidden NAME=dir VALUE=",Dir,">\n", - "<BR><INPUT TYPE=submit VALUE=Ok>\n" - "</FORM>\n"]. - -filter_files(Dir,[File|Files],Ds,Fs) -> - case filename:extension(File) of - ".coverdata" -> - Fs1 = ["<OPTION VALUE=",File," onDblClick=submit()>", - File,"</OPTION>\n" | Fs], - filter_files(Dir,Files,Ds,Fs1); - _ -> - FullName = filename:join(Dir,File), - case filelib:is_dir(FullName) of - true -> - Ds1 = ["<OPTION VALUE=",File," onDblClick=submit()>", - File,"/</OPTION>\n" | Ds], - filter_files(Dir,Files,Ds1,Fs); - false -> - filter_files(Dir,Files,Ds,Fs) - end - end; -filter_files(_Dir,[],Ds,Fs) -> - {Ds,Fs}. - - - - -do_import(Input) -> - case parse(Input) of - [{"file",File0},{"dir",Dir}] -> - File = filename:join(Dir,File0), - case filelib:is_dir(File) of - true -> - import_frame1(File); - false -> - case filelib:is_file(File) of - true -> - case cover:import(File) of - ok -> - import_frame1(Dir); - {error,{cant_open_file,ExportFile,_Reason}} -> - import_frame1(Dir, - "Error importing file\\n\\\"" - ++ ExportFile ++ "\\\"") - end; - false -> - import_frame1(Dir, - "Error importing file\\n\\\"" ++ - File ++ "\\\"") - end - end; - [{"dir",Dir}] -> - import_frame1(Dir,"No file is selected") - end. - - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% % -% Different private helper functions % -% % -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%Create the Header for the page If we now the mimetype use that type %% -%%otherwise use text %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -header() -> - header("text/html"). -header(MimeType) -> - "Pragma:no-cache\r\n" ++ - "Content-type: " ++ MimeType ++ "\r\n\r\n". - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%Create the Htmlheader set the title of the page %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -html_header(Title) -> - "<HTML>\n" ++ - "<HEAD>\n" ++ - "<TITLE>" ++ Title ++ "</TITLE>\n" ++ - "</HEAD>\n" - "<BODY BGCOLOR=\"#FFFFFF\">\n". - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Close the body- and Html tags %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -html_end()-> - "</BODY></HTML>". - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% A script which reloads the menu frame and possibly pops up an alert%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -reload_menu_script(Err) -> - ["<SCRIPT>\n", - "function reloadMenu()\n", - " {\n", - " parent.menu.document.location.href=\"./menu_frame\";\n", - case Err of - "" -> ""; - _ -> " alert(\""++Err++"\");\n" - end, - case get_warnings() of - [] -> - ""; - Warnings -> - " alert(\""++fix_newline(lists:flatten(Warnings))++"\");\n" - end, - " }\n", - "</SCRIPT>\n", - "<BODY onLoad=reloadMenu() BGCOLOR=\"#FFFFFF\">"]. - -fix_newline([$\n|Rest]) -> - [$\\,$n|fix_newline(Rest)]; -fix_newline([$"|Rest]) -> - [$\\,$"|fix_newline(Rest)]; -fix_newline([Char|Rest]) -> - [Char|fix_newline(Rest)]; -fix_newline([]) -> - []. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Control the input data and return the intresting values or error % -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -get_input_data(Input,Key)-> - case lists:keysearch(Key,1,parse(Input)) of - {value,{Key,Value}} -> - Value; - false -> - undefined - end. - -parse(Input) -> - httpd:parse_query(Input). - - -get_warnings() -> - cover_group_leader_proc ! {self(), get_warnings}, - receive {warnings,Warnings} -> - Warnings - end. diff --git a/lib/tools/src/cprof.erl b/lib/tools/src/cprof.erl index 0240f876bc..f6d68f0bf8 100644 --- a/lib/tools/src/cprof.erl +++ b/lib/tools/src/cprof.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2009. All Rights Reserved. +%% 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. @@ -114,6 +114,7 @@ analyse(Limit) when is_integer(Limit) -> analyse(M) when is_atom(M) -> analyse(M, 1). +-dialyzer({no_improper_lists, analyse/2}). analyse(M, Limit) when is_atom(M), is_integer(Limit) -> L0 = [begin MFA = {M,F,A}, diff --git a/lib/tools/src/fprof.erl b/lib/tools/src/fprof.erl index 7c6fab0b75..c5c24c8eb3 100644 --- a/lib/tools/src/fprof.erl +++ b/lib/tools/src/fprof.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2013. All Rights Reserved. +%% 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. @@ -2251,6 +2251,8 @@ do_analyse(Table, Analyse) -> ?dbg(5, "do_analyse_1(_, _) ->~p~n", [Result]), Result. +-dialyzer({no_improper_lists, do_analyse_1/2}). + do_analyse_1(Table, #analyse{group_leader = GroupLeader, dest = Io, @@ -2624,6 +2626,8 @@ funcstat_pd(Pid, Func1, Func0, Clocks) -> funcstat_sort_r(FuncstatList, Element) -> funcstat_sort_r_1(FuncstatList, Element, []). +-dialyzer({no_improper_lists, funcstat_sort_r_1/3}). + funcstat_sort_r_1([], _, R) -> postsort_r(lists:sort(R)); funcstat_sort_r_1([#funcstat{callers_sum = #clocks{} = Clocks, @@ -2646,6 +2650,8 @@ funcstat_sort_r_1([#funcstat{callers_sum = #clocks{} = Clocks, clocks_sort_r(L, E) -> clocks_sort_r_1(L, E, []). +-dialyzer({no_improper_lists, clocks_sort_r_1/3}). + clocks_sort_r_1([], _, R) -> postsort_r(lists:sort(R)); clocks_sort_r_1([#clocks{} = C | L], E, R) -> diff --git a/lib/tools/src/lcnt.erl b/lib/tools/src/lcnt.erl index e8b3d242e4..d552d5b46e 100644 --- a/lib/tools/src/lcnt.erl +++ b/lib/tools/src/lcnt.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2013. All Rights Reserved. +%% Copyright Ericsson AB 2010-2015. 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. @@ -94,12 +94,12 @@ -record(stats, { file :: atom(), - line :: non_neg_integer(), + line :: non_neg_integer() | 'undefined', tries :: non_neg_integer(), colls :: non_neg_integer(), time :: non_neg_integer(), % us nt :: non_neg_integer(), % #timings collected - hist :: tuple() % histogram + hist :: tuple() | 'undefined' % histogram }). -record(lock, { @@ -757,7 +757,7 @@ list2lock([F|Fs], Ls) -> stats2stats([]) -> []; stats2stats([Stat|Stats]) -> - Sz = tuple_size(#stats{}), + Sz = record_info(size, stats), [stat2stat(Stat,Sz)|stats2stats(Stats)]. stat2stat(Stat,Sz) when tuple_size(Stat) =:= Sz -> Stat; @@ -933,7 +933,6 @@ strings(Strings) -> strings(Strings, []). strings([], Out) -> Out; strings([{space, N, S} | Ss], Out) -> strings(Ss, Out ++ term2string(term2string("~~~ws", [N]), [S])); strings([{left, N, S} | Ss], Out) -> strings(Ss, Out ++ term2string(term2string(" ~~s~~~ws", [N]), [S,""])); -strings([{format, Format, S} | Ss], Out) -> strings(Ss, Out ++ term2string(Format, [S])); strings([S|Ss], Out) -> strings(Ss, Out ++ term2string("~ts", [S])). diff --git a/lib/tools/src/make.erl b/lib/tools/src/make.erl index 5d5a1ef2bd..26378f28a0 100644 --- a/lib/tools/src/make.erl +++ b/lib/tools/src/make.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. 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. @@ -299,10 +299,11 @@ check_includes(File, IncludePath, ObjMTime) -> end. check_includes2(Epp, File, ObjMTime) -> + A1 = erl_anno:new(1), case epp:parse_erl_form(Epp) of - {ok, {attribute, 1, file, {File, 1}}} -> + {ok, {attribute, A1, file, {File, A1}}} -> check_includes2(Epp, File, ObjMTime); - {ok, {attribute, 1, file, {IncFile, 1}}} -> + {ok, {attribute, A1, file, {IncFile, A1}}} -> case file:read_file_info(IncFile) of {ok, #file_info{mtime=MTime}} when MTime>ObjMTime -> epp:close(Epp), diff --git a/lib/tools/src/tools.app.src b/lib/tools/src/tools.app.src index 978b54719c..a00969eabe 100644 --- a/lib/tools/src/tools.app.src +++ b/lib/tools/src/tools.app.src @@ -21,7 +21,6 @@ [{description, "DEVTOOLS CXC 138 16"}, {vsn, "%VSN%"}, {modules, [cover, - cover_web, eprof, fprof, instrument, @@ -36,12 +35,12 @@ xref_utils ] }, - {registered,[webcover_server]}, + {registered, []}, {applications, [kernel, stdlib]}, {env, [{file_util_search_methods,[{"", ""}, {"ebin", "esrc"}, {"ebin", "src"}]} ] }, - {runtime_dependencies, ["webtool-0.8.10","stdlib-2.5","runtime_tools-1.8.14", + {runtime_dependencies, ["stdlib-2.5","runtime_tools-1.8.14", "kernel-3.0","inets-5.10","erts-7.0", "compiler-5.0"]} ] diff --git a/lib/tools/src/xref_utils.erl b/lib/tools/src/xref_utils.erl index 438ec93962..f69aa70244 100644 --- a/lib/tools/src/xref_utils.erl +++ b/lib/tools/src/xref_utils.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2014. All Rights Reserved. +%% 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. @@ -245,6 +245,8 @@ select_last_application_version(AppVs) -> TL = to_external(partition(1, relation(AppVs))), [last(keysort(2, L)) || L <- TL]. +-record(scan, {collected = [], errors = [], seen = [], unreadable = []}). + %% scan_directory(Directory, Recurse, Collect, Watch) -> %% {Collected, Errors, Seen, Unreadable} %% @@ -261,8 +263,9 @@ select_last_application_version(AppVs) -> %% Unreadable. %% scan_directory(File, Recurse, Collect, Watch) -> - Init = [[] | {[],[],[]}], - [L | {E,J,U}] = find_files_dir(File, Recurse, Collect, Watch, Init), + Init = #scan{}, + S = find_files_dir(File, Recurse, Collect, Watch, Init), + #scan{collected = L, errors = E, seen = J, unreadable = U} = S, {reverse(L), reverse(E), reverse(J), reverse(U)}. %% {Dir, Basename} | false @@ -576,8 +579,7 @@ find_files_dir(Dir, Recurse, Collect, Watch, L) -> {ok, Files} -> find_files(sort(Files), Dir, Recurse, Collect, Watch, L); {error, Error} -> - [B | {E,J,U}] = L, - [B | {[file_error(Dir, Error)|E],J,U}] + L#scan{errors = [file_error(Dir, Error)|L#scan.errors]} end. find_files([F | Fs], Dir, Recurse, Collect, Watch, L) -> @@ -588,22 +590,23 @@ find_files([F | Fs], Dir, Recurse, Collect, Watch, L) -> {ok, {_, directory, _, _}} -> L; Info -> - [B | EJU = {E,J,U}] = L, + #scan{collected = B, errors = E, + seen = J, unreadable = U} = L, Ext = filename:extension(File), C = member(Ext, Collect), case C of true -> case Info of {ok, {_, file, readable, _}} -> - [[{Dir,F} | B] | EJU]; + L#scan{collected = [{Dir,F} | B]}; {ok, {_, file, unreadable, _}} -> - [B | {E,J,[File|U]}]; + L#scan{unreadable = [File|U]}; Error -> - [B | {[Error|E],J,U}] + L#scan{errors = [Error|E]} end; false -> case member(Ext, Watch) of - true -> [B | {E,[File|J],U}]; + true -> L#scan{seen = [File|J]}; false -> L end end diff --git a/lib/tools/test/Makefile b/lib/tools/test/Makefile index 49b86628b7..8768413dc1 100644 --- a/lib/tools/test/Makefile +++ b/lib/tools/test/Makefile @@ -53,8 +53,7 @@ RELSYSDIR = $(RELEASE_PATH)/tools_test # FLAGS # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include \ - -I$(ERL_TOP)/lib/percept/include +ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/percept/include EBIN = . diff --git a/lib/tools/test/cover_SUITE.erl b/lib/tools/test/cover_SUITE.erl index 25c9317608..b9a9cd5be4 100644 --- a/lib/tools/test/cover_SUITE.erl +++ b/lib/tools/test/cover_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2015. All Rights Reserved. +%% 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. @@ -19,43 +19,17 @@ %% -module(cover_SUITE). --export([all/0, init_per_testcase/2, end_per_testcase/2, - suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2]). - --export([coverage/1, coverage_analysis/1, - start/1, compile/1, analyse/1, misc/1, stop/1, - distribution/1, reconnect/1, die_and_reconnect/1, - dont_reconnect_after_stop/1, stop_node_after_disconnect/1, - export_import/1, - otp_5031/1, eif/1, otp_5305/1, otp_5418/1, otp_6115/1, otp_7095/1, - otp_8188/1, otp_8270/1, otp_8273/1, otp_8340/1, - otp_10979_hanging_node/1, compile_beam_opts/1, eep37/1, - analyse_no_beam/1, line_0/1]). - --export([do_coverage/1]). - --export([distribution_performance/1]). - --include_lib("test_server/include/test_server.hrl"). - -%%---------------------------------------------------------------------- -%% The following directory structure is assumed: -%% cwd __________________________________________ -%% | \ \ \ \ \ \ \ -%% a b cc d f d1 compile_beam_____ otp_6115 -%% | \ \ \ \ \ \ \ -%% e crypt v w x d f1 f2 -%% | -%% y -%%---------------------------------------------------------------------- +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> NoStartStop = [eif,otp_5305,otp_5418,otp_7095,otp_8273, otp_8340,otp_8188,compile_beam_opts,eep37, - analyse_no_beam, line_0], + analyse_no_beam, line_0, compile_beam_no_file, + otp_13277], StartStop = [start, compile, analyse, misc, stop, distribution, reconnect, die_and_reconnect, dont_reconnect_after_stop, stop_node_after_disconnect, @@ -778,8 +752,8 @@ distribution_performance(Config) -> %% [{ok,_} = cover:compile_beam(Mod) || Mod <- Mods] %% end, CFun = fun() -> cover:compile_beam(Mods) end, - {CT,CA} = timer:tc(CFun), -% erlang:display(CA), + {CT,_CA} = timer:tc(CFun), +% erlang:display(_CA), erlang:display({compile,CT}), {SNT,_} = timer:tc(fun() -> {ok,[N1]} = cover:start(nodes()) end), @@ -799,7 +773,7 @@ distribution_performance(Config) -> % Fun = fun() -> cover:reset() end, - {AT,A} = timer:tc(Fun), + {AT,_A} = timer:tc(Fun), erlang:display({analyse,AT}), % erlang:display(lists:sort([X || X={_MFA,N} <- lists:append([L || {ok,L}<-A]), N=/=0])), @@ -1279,7 +1253,7 @@ otp_8340(doc) -> ["OTP-8340. Bug."]; otp_8340(suite) -> []; otp_8340(Config) when is_list(Config) -> - ?line [{{t,1},1},{{t,2},1},{{t,4},1}] = + ?line [{{t,1},1},{{t,4},1}] = analyse_expr(<<"<< \n" " <<3:2, \n" " SeqId:62>> \n" @@ -1573,8 +1547,10 @@ comprehension_8188(Cf) -> " true]. \n" % 2 " two() -> 2">>, Cf), % 1 + %% The template cannot have a counter since it is not allowed to + %% be a block. ?line [{{t,1},1}, - {{t,2},2}, + %% {{t,2},2}, {{t,3},1}, {{t,4},1}, {{t,5},0}, @@ -1584,7 +1560,7 @@ comprehension_8188(Cf) -> {{t,13},2}, {{t,14},2}] = analyse_expr(<<"<< \n" % 1 - " << (X*2) >> || \n" % 2 + " << (X*2) >> || \n" % 2 (now: 0) " <<X>> <= << (case two() of\n" " 2 -> 1;\n" % 1 " _ -> 2\n" % 0 @@ -1599,7 +1575,7 @@ comprehension_8188(Cf) -> "two() -> 2">>, Cf), ?line [{{t,1},1}, - {{t,2},4}, + %% {{t,2},4}, {{t,4},1}, {{t,6},1}, {{t,7},0}, @@ -1608,7 +1584,7 @@ comprehension_8188(Cf) -> {{t,12},4}, {{t,13},1}] = analyse_expr(<<"<< \n" % 1 - " << (2)\n" % 4 + " << (2)\n" % 4 (now: 0) " :(8) >> || \n" " <<X>> <= << 1,\n" % 1 " (case two() of \n" @@ -1746,6 +1722,49 @@ line_0(Config) -> ok. +%% OTP-13200: Return error instead of crashing when trying to compile +%% a beam which has no 'file' attribute. +compile_beam_no_file(Config) -> + PrivDir = ?config(priv_dir,Config), + Dir = filename:join(PrivDir,"compile_beam_no_file"), + ok = filelib:ensure_dir(filename:join(Dir,"*")), + code:add_patha(Dir), + Str = lists:concat( + ["-module(nofile).\n" + "-compile(export_all).\n" + "foo() -> ok.\n"]), + TT = do_scan(Str), + Forms = [ begin {ok,Y} = erl_parse:parse_form(X),Y end || X <- TT ], + {ok,_,Bin} = compile:forms(Forms,[debug_info]), + BeamFile = filename:join(Dir,"nofile.beam"), + ok = file:write_file(BeamFile,Bin), + {error,{no_file_attribute,BeamFile}} = cover:compile_beam(nofile), + [{error,{no_file_attribute,BeamFile}}] = cover:compile_beam_directory(Dir), + ok. + +do_scan([]) -> + []; +do_scan(Str) -> + {done,{ok,T,_},C} = erl_scan:tokens([],Str,0), + [ T | do_scan(C) ]. + +otp_13277(doc) -> + ["PR 856. Fix a bc bug."]; +otp_13277(Config) -> + Test = <<"-module(t). + -export([t/0]). + + pad(A, L) -> + P = << <<\"#\">> || _ <- lists:seq(1, L) >>, + <<A/binary, P/binary>>. + + t() -> + pad(<<\"hi\">>, 2). + ">>, + ?line File = cc_mod(t, Test, Config), + ?line <<"hi##">> = t:t(), + ?line ok = file:delete(File), + ok. %%--Auxiliary------------------------------------------------------------ diff --git a/lib/tools/test/cover_SUITE_data/cc.erl b/lib/tools/test/cover_SUITE_data/cc.erl index 587bdbe493..7eb165ef8a 100644 --- a/lib/tools/test/cover_SUITE_data/cc.erl +++ b/lib/tools/test/cover_SUITE_data/cc.erl @@ -1,88 +1,17 @@ -module(cc). --export([epp/1, epp/2, dbg/1, dbg/2, cvr/1, cvr/2]). --export([p/2, pp/2]). +-compile(export_all). -%% epp(Module) - Creates Module.epp which contains all forms of Module -%% as obtained by using epp. -%% -%% dbg(Module) - Creates Module.dbg which contains all forms of Module -%% as obtained by using beam_lib:chunks/2. -%% -%% cvr(Module) - Creates Module.cvr which contains all forms of Module -%% as obtained by using cover:transform/3. -%% +%% This is a dummy module used only for cover compiling. The content +%% of this module has no meaning for the test. -epp(Module) -> - epp(Module, p). -epp(Module, P) -> - File = atom_to_list(Module)++".erl", - {ok,Cwd} = file:get_cwd(), - {ok, Fd1} = epp:open(File, [Cwd], []), - {ok, Fd2} = file:open(atom_to_list(Module)++".epp", write), +foo() -> + T = erlang:time(), + spawn(fun() -> bar(T) end). - epp(Fd1, Fd2, P), - - epp:close(Fd1), - file:close(Fd2), - ok. - -epp(Fd1, Fd2, P) -> - case epp:parse_erl_form(Fd1) of - {ok, {attribute,Line,Attr,Data}} -> - epp(Fd1, Fd2, P); - {ok, Form} when P==p -> - io:format(Fd2, "~p.~n", [Form]), - epp(Fd1, Fd2, P); - {ok, Form} when P==pp -> - io:format(Fd2, "~p.~n", [erl_pp:form(Form)]), - epp(Fd1, Fd2, P); - {eof, Line} -> - ok - end. - -cvr(Module) -> - cvr(Module, p). -cvr(Module, P) -> - case beam_lib:chunks(Module, [abstract_code]) of - {ok, {Module, [{abstract_code, no_abstract_code}]}} -> - {error, {no_debug_info,Module}}; - {ok, {Module, [{abstract_code, {Vsn, Forms}}]}} -> - Vars = {vars,Module,Vsn, [], - undefined, undefined, undefined, undefined, undefined, - undefined, - false}, - {ok, TForms, _Vars2} = cover:transform(Forms, [], Vars), - File = atom_to_list(Module)++".cvr", - apply(?MODULE, P, [File, TForms]); - Error -> - Error +bar(T) -> + receive + X -> + T1 = erlang:time(), + io:format("received ~p at ~p. Last time: ~p~n",[X,T1,T]), + bar(T1) end. - -dbg(Module) -> - dbg(Module, p). -dbg(Module, P) -> - case beam_lib:chunks(Module, [abstract_code]) of - {ok, {Module, [{abstract_code, no_abstract_code}]}} -> - {error, {no_debug_info,Module}}; - {ok, {Module, [{abstract_code, {Vsn, Forms}}]}} -> - File = atom_to_list(Module)++".dbg", - apply(?MODULE, P, [File, Forms]); - Error -> - Error - end. - -p(File, Forms) -> - {ok, Fd} = file:open(File, write), - lists:foreach(fun(Form) -> - io:format(Fd, "~p.~n", [Form]) - end, - Forms), - file:close(Fd). - -pp(File, Forms) -> - {ok, Fd} = file:open(File, write), - lists:foreach(fun(Form) -> - io:format(Fd, "~s", [erl_pp:form(Form)]) - end, - Forms), - file:close(Fd). diff --git a/lib/tools/test/cover_SUITE_data/d.erl b/lib/tools/test/cover_SUITE_data/d.erl index 696e27e49b..b1d8ebd62e 100644 --- a/lib/tools/test/cover_SUITE_data/d.erl +++ b/lib/tools/test/cover_SUITE_data/d.erl @@ -6,7 +6,7 @@ size/0]). -export([init/0]). % spawn --record(person, {name, age, location, moved=false}). +-record(person, {name, age :: integer(), location, moved=false :: boolean()}). %%%---------------------------------------------------------------------- %%% User interface functions diff --git a/lib/tools/test/cprof_SUITE.erl b/lib/tools/test/cprof_SUITE.erl index 7b22dea7ed..8beaf4f399 100644 --- a/lib/tools/test/cprof_SUITE.erl +++ b/lib/tools/test/cprof_SUITE.erl @@ -42,7 +42,7 @@ -define(config(A,B),config(A,B)). -export([config/2]). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -endif. -ifdef(debug). diff --git a/lib/tools/test/emem_SUITE.erl b/lib/tools/test/emem_SUITE.erl index 95cda98558..93d21623ce 100644 --- a/lib/tools/test/emem_SUITE.erl +++ b/lib/tools/test/emem_SUITE.erl @@ -43,7 +43,7 @@ -include_lib("kernel/include/file.hrl"). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(DEFAULT_TIMEOUT, ?t:minutes(5)). diff --git a/lib/tools/test/eprof_SUITE.erl b/lib/tools/test/eprof_SUITE.erl index 5428643667..6274eabc37 100644 --- a/lib/tools/test/eprof_SUITE.erl +++ b/lib/tools/test/eprof_SUITE.erl @@ -19,7 +19,7 @@ %% -module(eprof_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). diff --git a/lib/tools/test/fprof_SUITE.erl b/lib/tools/test/fprof_SUITE.erl index e8f179c630..d1a673d6b7 100644 --- a/lib/tools/test/fprof_SUITE.erl +++ b/lib/tools/test/fprof_SUITE.erl @@ -19,7 +19,7 @@ %% -module(fprof_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Test server framework exports -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/lib/tools/test/ignore_cores.erl b/lib/tools/test/ignore_cores.erl index 13f34cd10f..e40b91392c 100644 --- a/lib/tools/test/ignore_cores.erl +++ b/lib/tools/test/ignore_cores.erl @@ -28,7 +28,7 @@ -module(ignore_cores). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([init/1, fini/1, setup/3, setup/4, restore/1, dir/1]). diff --git a/lib/tools/test/instrument_SUITE.erl b/lib/tools/test/instrument_SUITE.erl index 3b981a9303..773d805cd0 100644 --- a/lib/tools/test/instrument_SUITE.erl +++ b/lib/tools/test/instrument_SUITE.erl @@ -25,7 +25,7 @@ -export(['+Mim true'/1, '+Mis true'/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). init_per_testcase(_Case, Config) -> ?line Dog=?t:timetrap(10000), diff --git a/lib/tools/test/lcnt_SUITE.erl b/lib/tools/test/lcnt_SUITE.erl index f3789a4137..47b8031bee 100644 --- a/lib/tools/test/lcnt_SUITE.erl +++ b/lib/tools/test/lcnt_SUITE.erl @@ -19,7 +19,7 @@ %% -module(lcnt_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Test server specific exports -export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2]). diff --git a/lib/tools/test/make_SUITE.erl b/lib/tools/test/make_SUITE.erl index 70bc8502bf..fdcc310df1 100644 --- a/lib/tools/test/make_SUITE.erl +++ b/lib/tools/test/make_SUITE.erl @@ -25,7 +25,7 @@ otp_6057_a/1, otp_6057_b/1, otp_6057_c/1, otp_6057_end/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). diff --git a/lib/tools/test/tools_SUITE.erl b/lib/tools/test/tools_SUITE.erl index 9403124c96..ae2a69305b 100644 --- a/lib/tools/test/tools_SUITE.erl +++ b/lib/tools/test/tools_SUITE.erl @@ -19,7 +19,7 @@ %% -module(tools_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Default timetrap timeout (set in init_per_testcase). -define(default_timeout, ?t:minutes(1)). diff --git a/lib/tools/test/xref_SUITE.erl b/lib/tools/test/xref_SUITE.erl index ad47b31443..53aa80d2a3 100644 --- a/lib/tools/test/xref_SUITE.erl +++ b/lib/tools/test/xref_SUITE.erl @@ -30,7 +30,7 @@ -define(privdir, "xref_SUITE_priv"). -define(copydir, "xref_SUITE_priv/datacopy"). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(format(S, A), ok). -define(datadir, ?config(data_dir, Conf)). -define(privdir, ?config(priv_dir, Conf)). @@ -1151,17 +1151,13 @@ read_expected(Version) -> {POS8+4,{FF,{a,b,1}}}, {POS8+4,{FF,{erlang,apply,2}}}, {POS8+5,{FF,{erlang,apply,2}}}, - {POS8+6,{FF,{erlang,apply,3}}}, {POS8+6,{FF,{m,f,1}}}, - {POS8+7,{FF,{erlang,apply,3}}}, - {POS9+1,{FF,{erlang,apply,3}}}, {POS9+1,{FF,{read,bi,0}}}, {POS9+2,{FF,{a,b,1}}}, {POS9+2,{FF,{erlang,apply,2}}}, {POS9+3,{FF,{erlang,apply,2}}}, {POS9+4,{FF,{erlang,apply,2}}}, {POS9+4,{FF,{erlang,not_a_function,1}}}, - {POS9+5,{FF,{erlang,apply,3}}}, {POS9+5,{FF,{mod,func,2}}}, {POS9+6,{FF,{erlang,apply,1}}}, {POS9+7,{FF,{erlang,apply,2}}}, @@ -1169,17 +1165,11 @@ read_expected(Version) -> {POS9+8,{FF,{q,f,1}}}, {POS10+4,{FF,{erlang,apply,2}}}, {POS10+5,{FF,{mod1,fun1,1}}}, - {POS11+1,{FF,{erlang,apply,3}}}, - {POS11+2,{FF,{erlang,apply,3}}}, - {POS11+3,{FF,{erlang,apply,3}}}, - {POS11+4,{FF,{erlang,apply,3}}}, {POS11+6,{FF,{erlang,apply,2}}}, {POS12+1,{FF,{erlang,apply,2}}}, {POS12+4,{FF,{erlang,apply,2}}}, - {POS12+5,{FF,{erlang,apply,3}}}, {POS12+5,{FF,{m3,f3,2}}}, {POS12+7,{FF,{erlang,apply,2}}}, - {POS12+8,{FF,{erlang,apply,3}}}, {POS13+1,{FF,{dm,df,1}}}, {POS13+6,{{read,bi,0},{foo,module_info,0}}}, {POS13+7,{{read,bi,0},{read,module_info,0}}}, @@ -1189,10 +1179,6 @@ read_expected(Version) -> OK = case Version of abstract_v1 -> - [{POS8+3, {FF,{erlang,apply,3}}}, - {POS10+1, {FF,{erlang,apply,3}}}, - {POS10+6, {FF,{erlang,apply,3}}}] - ++ [{0,{FF,{read,'$F_EXPR',178}}}, {0,{FF,{modul,'$F_EXPR',179}}}] ++ O1; @@ -1213,13 +1199,25 @@ read_expected(Version) -> {POS3+3, {FF,{erlang,spawn_link,3}}}, {POS3+4, {FF,{erlang,spawn_link,3}}}, {POS6+4, {FF,{erlang,spawn,3}}}, + {POS8+6,{FF,{erlang,apply,3}}}, + {POS8+7,{FF,{erlang,apply,3}}}, + {POS9+1,{FF,{erlang,apply,3}}}, + {POS9+5,{FF,{erlang,apply,3}}}, + {POS11+1,{FF,{erlang,apply,3}}}, + {POS11+2,{FF,{erlang,apply,3}}}, + {POS11+3,{FF,{erlang,apply,3}}}, + {POS11+4,{FF,{erlang,apply,3}}}, + {POS12+5,{FF,{erlang,apply,3}}}, + {POS12+8,{FF,{erlang,apply,3}}}, {POS13+5, {{read,bi,0},{erlang,length,1}}}, {POS14+3, {{read,bi,0},{erlang,length,1}}}], %% Operators (OTP-8647): OKB = case Version of abstract_v1 -> - []; + [{POS8+3, {FF,{erlang,apply,3}}}, + {POS10+1, {FF,{erlang,apply,3}}}, + {POS10+6, {FF,{erlang,apply,3}}}]; _ -> [{POS13+16, {{read,bi,0},{erlang,'!',2}}}, {POS13+16, {{read,bi,0},{erlang,'-',1}}}, diff --git a/lib/typer/src/typer.erl b/lib/typer/src/typer.erl index 562530c868..5c82750a21 100644 --- a/lib/typer/src/typer.erl +++ b/lib/typer/src/typer.erl @@ -2,7 +2,7 @@ %%----------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2015. All Rights Reserved. +%% Copyright Ericsson AB 2006-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. @@ -137,11 +137,14 @@ extract(#analysis{macros = Macros, NewCodeServer = try NewRecords = dialyzer_codeserver:get_temp_records(CodeServer1), + NewExpTypes = dialyzer_codeserver:get_temp_exported_types(CodeServer1), + case sets:size(NewExpTypes) of 0 -> ok end, OldRecords = dialyzer_plt:get_types(TrustPLT), % XXX change to the PLT? MergedRecords = dialyzer_utils:merge_records(NewRecords, OldRecords), CodeServer2 = dialyzer_codeserver:set_temp_records(MergedRecords, CodeServer1), - CodeServer3 = dialyzer_utils:process_record_remote_types(CodeServer2), - dialyzer_contracts:process_contract_remote_types(CodeServer3) + CodeServer3 = dialyzer_codeserver:finalize_exported_types(NewExpTypes, CodeServer2), + CodeServer4 = dialyzer_utils:process_record_remote_types(CodeServer3), + dialyzer_contracts:process_contract_remote_types(CodeServer4) catch throw:{error, ErrorMsg} -> compile_error(ErrorMsg) @@ -845,8 +848,7 @@ collect_info(Analysis) -> %% io:format("Merged Records ~p",[MergedRecords]), TmpCServer1 = dialyzer_codeserver:set_temp_records(MergedRecords, TmpCServer), TmpCServer2 = - dialyzer_codeserver:insert_temp_exported_types(MergedExpTypes, - TmpCServer1), + dialyzer_codeserver:finalize_exported_types(MergedExpTypes, TmpCServer1), TmpCServer3 = dialyzer_utils:process_record_remote_types(TmpCServer2), dialyzer_contracts:process_contract_remote_types(TmpCServer3) catch diff --git a/lib/typer/test/Makefile b/lib/typer/test/Makefile index d6dd22b6cf..fb5570d9f0 100644 --- a/lib/typer/test/Makefile +++ b/lib/typer/test/Makefile @@ -25,7 +25,7 @@ RELSYSDIR = $(RELEASE_PATH)/typer_test # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +ERL_COMPILE_FLAGS += EBIN = . diff --git a/lib/webtool/AUTHORS b/lib/webtool/AUTHORS deleted file mode 100644 index 5f173dd264..0000000000 --- a/lib/webtool/AUTHORS +++ /dev/null @@ -1,4 +0,0 @@ -Original Authors and Contributors: - -Siri Hansen -Martin Gustafsson diff --git a/lib/webtool/Makefile b/lib/webtool/Makefile deleted file mode 100644 index 9afcb87af2..0000000000 --- a/lib/webtool/Makefile +++ /dev/null @@ -1,39 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 2001-2009. 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_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Common Macros -# ---------------------------------------------------- - -SUB_DIRECTORIES = src priv doc/src - -include vsn.mk -VSN = $(WEBTOOL_VSN) - -SPECIAL_TARGETS = - -# ---------------------------------------------------- -# Default Subdir Targets -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_subdir.mk - - diff --git a/lib/webtool/doc/html/.gitignore b/lib/webtool/doc/html/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/webtool/doc/html/.gitignore +++ /dev/null diff --git a/lib/webtool/doc/man1/.gitignore b/lib/webtool/doc/man1/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/webtool/doc/man1/.gitignore +++ /dev/null diff --git a/lib/webtool/doc/man3/.gitignore b/lib/webtool/doc/man3/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/webtool/doc/man3/.gitignore +++ /dev/null diff --git a/lib/webtool/doc/pdf/.gitignore b/lib/webtool/doc/pdf/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/webtool/doc/pdf/.gitignore +++ /dev/null diff --git a/lib/webtool/doc/src/Makefile b/lib/webtool/doc/src/Makefile deleted file mode 100644 index 57de52a616..0000000000 --- a/lib/webtool/doc/src/Makefile +++ /dev/null @@ -1,132 +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 Utvecklings AB. -# Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings -# AB. All Rights Reserved.'' -# -# $Id$ -# -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../../vsn.mk -VSN=$(WEBTOOL_VSN) -APPLICATION=webtool - -DOC_EXTRA_FRONT_PAGE_INFO=Important note: \ -The Webtool application is obsolete and will be removed \ -in the next major OTP release - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- -XML_APPLICATION_FILES = ref_man.xml - -XML_REF1_FILES = start_webtool.xml - -XML_REF3_FILES = webtool.xml - -XML_PART_FILES = \ - part.xml \ - part_notes.xml \ - part_notes_history.xml - -XML_CHAPTER_FILES = \ - webtool_chapter.xml \ - notes.xml \ - notes_history.xml - -BOOK_FILES = book.xml - -XML_FILES = \ - $(BOOK_FILES) $(XML_CHAPTER_FILES) \ - $(XML_PART_FILES) $(XML_REF3_FILES) \ - $(XML_REF1_FILES) $(XML_APPLICATION_FILES) - -GIF_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) - -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 -f $(MAN1DIR)/* - rm -f $(MAN3DIR)/* - rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f errs core *~ - -man: $(MAN1_FILES) $(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/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: - diff --git a/lib/webtool/doc/src/book.xml b/lib/webtool/doc/src/book.xml deleted file mode 100644 index feccee7c62..0000000000 --- a/lib/webtool/doc/src/book.xml +++ /dev/null @@ -1,48 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE book SYSTEM "book.dtd"> - -<book xmlns:xi="http://www.w3.org/2001/XInclude"> - <header titlestyle="normal"> - <copyright> - <year>2001</year><year>2013</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>WebTool</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev>1.0</rev> - </header> - <insidecover> - </insidecover> - <pagetext>WebTool</pagetext> - <preamble> - </preamble> - <parts lift="no"> - <xi:include href="part.xml"/> - </parts> - <applications> - <xi:include href="ref_man.xml"/> - </applications> - <releasenotes> - <xi:include href="notes.xml"/> - </releasenotes> - <listofterms></listofterms> - <index></index> -</book> - diff --git a/lib/webtool/doc/src/fascicules.xml b/lib/webtool/doc/src/fascicules.xml deleted file mode 100644 index 37feca543f..0000000000 --- a/lib/webtool/doc/src/fascicules.xml +++ /dev/null @@ -1,18 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="part" href="part_frame.html" entry="no"> - User's Guide - </fascicule> - <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> - Reference Manual - </fascicule> - <fascicule file="part_notes" href="part_notes_frame.html" entry="no"> - Release Notes - </fascicule> - <fascicule file="" href="../../../../doc/print.html" entry="no"> - Off-Print - </fascicule> -</fascicules> - diff --git a/lib/webtool/doc/src/notes.xml b/lib/webtool/doc/src/notes.xml deleted file mode 100644 index 21309261a8..0000000000 --- a/lib/webtool/doc/src/notes.xml +++ /dev/null @@ -1,253 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE chapter SYSTEM "chapter.dtd"> - -<chapter> - <header> - <copyright> - <year>2004</year><year>2013</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>Webtool Release Notes</title> - <prepared>otp_appnotes</prepared> - <docno>nil</docno> - <date>nil</date> - <rev>nil</rev> - <file>notes.xml</file> - </header> - <p>This document describes the changes made to the Webtool - application.</p> - -<section><title>WebTool 0.9</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - The Webtool application has been marked as obsolete and - will be removed from OTP in the next major release (OTP - 19.0).</p> - <p> - Own Id: OTP-10922 Aux Id: OTP-12705 </p> - </item> - </list> - </section> - -</section> - -<section><title>WebTool 0.8.10</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - Application upgrade (appup) files are corrected for the - following applications: </p> - <p> - <c>asn1, common_test, compiler, crypto, debugger, - dialyzer, edoc, eldap, erl_docgen, et, eunit, gs, hipe, - inets, observer, odbc, os_mon, otp_mibs, parsetools, - percept, public_key, reltool, runtime_tools, ssh, - syntax_tools, test_server, tools, typer, webtool, wx, - xmerl</c></p> - <p> - A new test utility for testing appup files is added to - test_server. This is now used by most applications in - OTP.</p> - <p> - (Thanks to Tobias Schlager)</p> - <p> - Own Id: OTP-11744</p> - </item> - </list> - </section> - -</section> - -<section><title>WebTool 0.8.9.2</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - Misc build updates</p> - <p> - Own Id: OTP-10784</p> - </item> - </list> - </section> - -</section> - -<section><title>WebTool 0.8.9.1</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - Miscellaneous documentation build updates</p> - <p> - Own Id: OTP-9813</p> - </item> - </list> - </section> - -</section> - -<section><title>WebTool 0.8.9</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - Do not install *.bat files on non-win32 machines (Thanks - to Hans Ulrich Niedermann)</p> - <p> - Own Id: OTP-9515</p> - </item> - </list> - </section> - -</section> - -<section><title>WebTool 0.8.8</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - Various small documentation fixes (Thanks to Bernard - Duggan)</p> - <p> - Own Id: OTP-9172</p> - </item> - </list> - </section> - -</section> - -<section><title>WebTool 0.8.7</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - Up until now Netscape has been the default web browser on - Unix/Linux. Webtool has now been updated to start Firefox - as default browser instead.</p> - <p> - Own Id: OTP-8651 Aux Id: OTP-8650 </p> - </item> - </list> - </section> - -</section> - -<section><title>WebTool 0.8.6</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - Misc updates</p> - <p> - Own Id: OTP-8456</p> - </item> - </list> - </section> - -</section> - -<section><title>WebTool 0.8.5</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - The documentation is now built with open source tools - (xsltproc and fop) that exists on most platforms. One - visible change is that the frames are removed.</p> - <p> - Own Id: OTP-8201</p> - </item> - </list> - </section> - -</section> - -<section><title>WebTool 0.8.4</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p>The copyright notices have been updated.</p> - <p> - Own Id: OTP-7851</p> - </item> - </list> - </section> - -</section> -<section><title>WebTool 0.8.3.2</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - Minor updates.</p> - <p> - Own Id: OTP-6998</p> - </item> - </list> - </section> - -</section> - - <section> - <title>WebTool 0.8.3.1</title> - - <section> - <title>Improvements and New Features</title> - <list type="bulleted"> - <item> - <p>Minor Makefile changes.</p> - <p>Own Id: OTP-6689</p> - </item> - <item> - <p>Obsolete guard tests (such as list()) have been replaced - with the modern guard tests (such as is_list()).</p> - <p>Own Id: OTP-6725</p> - </item> - </list> - </section> - </section> - - <section> - <title>WebTool 0.8.3</title> - - <section> - <title>Improvements and New Features</title> - <list type="bulleted"> - <item> - <p>Removed some dead code discovered by Dialyzer.</p> - <p>Own Id: OTP-6041</p> - </item> - </list> - </section> - </section> -</chapter> - diff --git a/lib/webtool/doc/src/notes_history.xml b/lib/webtool/doc/src/notes_history.xml deleted file mode 100644 index 792475d948..0000000000 --- a/lib/webtool/doc/src/notes_history.xml +++ /dev/null @@ -1,74 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE chapter SYSTEM "chapter.dtd"> - -<chapter> - <header> - <copyright> - <year>2006</year> - <year>2013</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. - - The Initial Developer of the Original Code is Ericsson AB. - </legalnotice> - - <title>Webtool Release Notes History</title> - <prepared>otp_appnotes</prepared> - <docno>nil</docno> - <date>nil</date> - <rev>nil</rev> - </header> - - <section> - <title>Webtool 0.8.2</title> - - <section> - <title>Fixed Bugs and Malfunctions</title> - <list type="bulleted"> - <item> - <p>Bugfix: <c>webtool</c> crashed when trying to find a free - port number if connection failed with other reason than - <c>econnrefused</c>.</p> - <p>Own Id: OTP-5166</p> - </item> - </list> - </section> - - <section> - <title>Improvements and New Features</title> - <list type="bulleted"> - <item> - <p>Misc improvements:</p> - <list type="bulleted"> - <item>The function <c>debug_app/1</c> and some error - printouts are added to simplify debugging of own - application.</item> - <item>Multiple webtool instances can now be started on - the same host. If the default port (8888) is in use, port - 8889 is tried. If 8889 is also used, 8890 is tried and so - on. Max number of ports tried is 256.</item> - <item><em>Incompatible:</em> If <c>Data</c> is set to - <c>PortNumber</c> in <c>start(Path,Data)</c>, the default - data will be used for ip-number (<c>127.0.0.1</c>) and - server name (<c>localhost</c>).</item> - </list> - <p>*** POTENTIAL INCOMPATIBILITY ***</p> - <p>Own Id: OTP-4724</p> - </item> - </list> - </section> - </section> -</chapter> - diff --git a/lib/webtool/doc/src/part.xml b/lib/webtool/doc/src/part.xml deleted file mode 100644 index b0c4ee310d..0000000000 --- a/lib/webtool/doc/src/part.xml +++ /dev/null @@ -1,38 +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>2001</year><year>2013</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>WebTool User's Guide</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - </header> - <description> - <p><em>WebTool</em> provides a easy way to use web based tools with - Erlang/OTP. It configures and starts a webserver as well as all - available tools.</p> - </description> - <xi:include href="webtool_chapter.xml"/> -</part> - diff --git a/lib/webtool/doc/src/part_notes.xml b/lib/webtool/doc/src/part_notes.xml deleted file mode 100644 index db2b790f3f..0000000000 --- a/lib/webtool/doc/src/part_notes.xml +++ /dev/null @@ -1,40 +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>2004</year><year>2013</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>WebTool Release Notes</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - </header> - <description> - <p><em>WebTool</em> provides an easy way to use web based tools with - Erlang/OTP. It configures and starts a webserver as well as all - available tools.</p> - <p>For information about older versions, see - <url href="part_notes_history_frame.html">Release Notes History</url>.</p> - </description> - <xi:include href="notes"/> -</part> - diff --git a/lib/webtool/doc/src/part_notes_history.xml b/lib/webtool/doc/src/part_notes_history.xml deleted file mode 100644 index 50ce62e58d..0000000000 --- a/lib/webtool/doc/src/part_notes_history.xml +++ /dev/null @@ -1,40 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part> - <header> - <copyright> - <year>2006</year> - <year>2013</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. - - The Initial Developer of the Original Code is Ericsson AB. - </legalnotice> - - <title>WebTool Release Notes History</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - </header> - <description> - <p><em>WebTool</em> provides a easy way to use web based tools with - Erlang/OTP. It configures and starts a webserver as well as all - available tools.</p> - </description> - <include file="notes_history"></include> -</part> - diff --git a/lib/webtool/doc/src/ref_man.xml b/lib/webtool/doc/src/ref_man.xml deleted file mode 100644 index aa81392b11..0000000000 --- a/lib/webtool/doc/src/ref_man.xml +++ /dev/null @@ -1,39 +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>2001</year><year>2013</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>WebTool Reference Manual</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - </header> - <description> - <p><em>WebTool</em> provides an easy way to use web based tools with - Erlang/OTP. It configures and starts a webserver as well as all - available tools.</p> - </description> - <xi:include href="webtool.xml"/> - <xi:include href="start_webtool.xml"/> -</application> - diff --git a/lib/webtool/doc/src/start_webtool.xml b/lib/webtool/doc/src/start_webtool.xml deleted file mode 100644 index e9c94c4271..0000000000 --- a/lib/webtool/doc/src/start_webtool.xml +++ /dev/null @@ -1,104 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE comref SYSTEM "comref.dtd"> - -<comref> - <header> - <copyright> - <year>2003</year><year>2013</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>start_webtool</title> - <prepared></prepared> - <responsible></responsible> - <docno>1</docno> - <approved></approved> - <checked></checked> - <date>2003-06-18</date> - <rev></rev> - <file>start_webtool.sgml</file> - </header> - <com>start_webtool</com> - <comsummary>WebTool Start Script</comsummary> - <description> - <p>The <c>start_webtool</c> script starts WebTool, a WebTool - application and a web browser pointing to this application.</p> - </description> - <funcs> - <func> - <name>start_webtool application [ browser ]</name> - <fsummary>Start a WebTool Application</fsummary> - <desc> - <p>Starts WebTool, the given WebTool Application and a web - browser pointing to this application. - </p> - <p>If no argument is given, a list of available applications - is displayed, e.g.</p> - <pre> ->start_webtool -Starting webtool... -WebTool is available at http://localhost:8888/ -Or http://127.0.0.1:8888/ - -Usage: start_webtool application [ browser ] - -Available applications are: [orber,appmon,crashdump_viewer,webcover] -Default browser is 'iexplore' (Internet Explorer) on Windows or else 'firefox' </pre> - <p>To start any of the listed applications, give the - application name as the first argument, e.g.</p> - <pre> ->start_webtool webcover -Starting webtool... -WebTool is available at http://localhost:8888/ -Or http://127.0.0.1:8888/ -Starting webcover... -Sending URL to netscape...done </pre> - <p>The WebTool application WebCover is then started and the - default browser is used. The default browser is Internet - Explorer on Windows or else Firefox. - </p> - <p>To use another browser, give the browser's start command - as the second argument, e.g.</p> - <pre> ->start_webtool webcover mozilla -Starting webtool... -WebTool is available at http://localhost:8888/ -Or http://127.0.0.1:8888/ -Starting webcover... -Sending URL to mozilla...done </pre> - <p>If the given browser name is not known to WebTool, WebTool - will run it as a command with the start URL as the only - argument, e.g.</p> - <pre> ->start_webtool webcover mybrowser -Starting webtool... -WebTool is available at http://localhost:8888/ -Or http://127.0.0.1:8888/ -Starting webcover... -Starting mybrowser... </pre> - <p>Here the command <c>"mybrowser http://localhost:8888/webcover"</c> is executed. - </p> - </desc> - </func> - </funcs> - - <section> - <title>See Also</title> - <p><seealso marker="webtool">webtool(3)</seealso></p> - </section> -</comref> - diff --git a/lib/webtool/doc/src/webtool.xml b/lib/webtool/doc/src/webtool.xml deleted file mode 100644 index 2647518dae..0000000000 --- a/lib/webtool/doc/src/webtool.xml +++ /dev/null @@ -1,157 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE erlref SYSTEM "erlref.dtd"> - -<erlref> - <header> - <copyright> - <year>2001</year> - <year>2013</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. - - The Initial Developer of the Original Code is Ericsson AB. - </legalnotice> - - <title>webtool</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - </header> - <module>webtool</module> - <modulesummary>WebTool is a tool used to simplify the implementation of web based tools with Erlang/OTP.</modulesummary> - <description> - <p>WebTool makes it easy to use web based tools with Erlang/OTP. WebTool - configures and starts the webserver httpd.</p> - </description> - <funcs> - <func> - <name>start()-> {ok,Pid}| {stop,Reason}</name> - <fsummary>Start WebTool.</fsummary> - <desc> - <p>Start WebTool with default data, i.e. port 8888, ip-number - 127.0.0.1, and server-name <c>localhost</c>. If port 8888 is - in use, port 8889 is tried instead. If 8889 is also in use, - 8890 is tried and so on. Max number of ports tried is 256. - </p> - <p>The <c>mime.types</c> file and WebTool's own HTML files - are assumed to be in the directory - <c><![CDATA[webtool-<vsn>/priv/root/conf]]></c>.</p> - </desc> - </func> - <func> - <name>start(Path,Data)->{ok,Pid}|{stop,Reason}</name> - <fsummary>Start WebTool with default configuration.</fsummary> - <type> - <v>Path = string() | standard_path</v> - <v>Data = [Port,Address,Name] | PortNumber | standard_data</v> - <v>Port = {port,PortNumber}</v> - <v>Address = {bind_address,IpNumber}</v> - <v>Name = {server_name,ServerName}</v> - <v>PortNumber = integer()</v> - <v>IpNumber = tuple(), e.g. {127,0,0,1}</v> - <v>ServerName = string()</v> - <v>Pid = pid()</v> - </type> - <desc> - <p>Use this function to start WebTool if the default port, - ip-number,servername or path can not be used.</p> - <p><c>Path</c> is the directory where the <c>mime.types</c> - file and WebTool's own HTML files are located. By default - this is <c><![CDATA[webtool-<vsn>/priv]]></c>, and in most cases there - is no need to change this. If <c>Path</c> is set to - <c>standard_path</c> the default will be used.</p> - <p>If <c>Data</c> is set to <c>PortNumber</c>, the default data - will be used for ip-number (<c>127.0.0.1</c>) and server - name (<c>localhost</c>).</p> - </desc> - </func> - <func> - <name>stop()->void</name> - <fsummary>Stop WebTool.</fsummary> - <desc> - <p>Stop WebTool and the tools started by WebTool.</p> - </desc> - </func> - <func> - <name>debug_app(Module)->void</name> - <fsummary>Debug a WebTool application.</fsummary> - <type> - <v>Module = atom()</v> - </type> - <desc> - <p>Debug a WebTool application by tracing all functions in the - given module which are called from WebTool.</p> - </desc> - </func> - <func> - <name>stop_debug()->void</name> - <fsummary>Stop debugging an application and format the trace log.</fsummary> - <desc> - <p>Stop the tracing started by <c>debug_app/1</c>, and format - the trace log.</p> - </desc> - </func> - </funcs> - - <section> - <title>CALLBACK FUNCTIONS</title> - <p>The following callback function must be implemented by each web - based tool that will be used via WebTool. When started, WebTool - searches the Erlang code path for *.tool files to locate all web - based tools and their callback functions. See the <seealso marker="webtool_chapter">WebTool User's Guide</seealso> for more - information about the *.tool files.</p> - </section> - <funcs> - <func> - <name>Module:Func(Data)-> {Name,WebData}|error</name> - <fsummary>Returns configuration data needed by WebTool to configure and start a tool.</fsummary> - <type> - <v>Data = term()</v> - <v>Name = atom()</v> - <v>WebData = [WebOptions]</v> - <v>WebOptions = LinkData | Alias | Start</v> - <v>LinkData = {web_data,{ToolName,Url}}</v> - <v>Alias = {alias,{VirtualPath,RealPath}} | {alias,{erl_alias,Path,[Modules]}</v> - <v>Start = {start,StartData}</v> - <v>ToolName = Url = VirtualPath = RealPath = Path = string()</v> - <v>Modules = atom()</v> - <v>StartData = AppData | ChildSpec | Func</v> - <v>AppData = {app,AppName}</v> - <v>ChildSpec = {child,child_spec()}</v> - <d>See the Reference Manual for the module supervisor in the STDLIB application for details about child_spec().</d> - <v>Func = {func,{StartMod,StartFunc,StartArg}, {StopMod,StopFunc,StopArg}}</v> - <v>AppName = StartMod = StartFunc = StopMod = StopFunc =atom()</v> - <v>StartArg = StopArg = [term()]</v> - </type> - <desc> - <p>This is the configuration function (<c>config_func</c>) - which must be stated in the <c>*.tool</c> file.</p> - <p>The function is called by WebTool at startup to retrieve the - data needed to start and configure the tool. <c>LinkData</c> is - used by WebTool to create the link to the tool. <c>Alias</c> is - used to create the aliases needed by the webserver. <c>Start</c> - is used to start and stop the tool.</p> - </desc> - </func> - </funcs> - - <section> - <title>See Also</title> - <p><seealso marker="start_webtool">start_webtool(1)</seealso>, - <seealso marker="webtool_chapter">WebTool User's Guide</seealso></p> - </section> -</erlref> - diff --git a/lib/webtool/doc/src/webtool_chapter.xml b/lib/webtool/doc/src/webtool_chapter.xml deleted file mode 100644 index 160a42f855..0000000000 --- a/lib/webtool/doc/src/webtool_chapter.xml +++ /dev/null @@ -1,246 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE chapter SYSTEM "chapter.dtd"> - -<chapter> - <header> - <copyright> - <year>2001</year><year>2013</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>WebTool User Guide</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - <file>webtool_chapter.xml</file> - </header> - - <section> - <title>Introduction </title> - <p>WebTool provides an easy and efficient way to implement web - based tools with Erlang/OTP. WebTool configures and starts the - webserver and the various web based tools.</p> - <p>All tools that shall run under WebTool must have a *.tool - file in the code path or in its priv directory. When WebTool - starts it searches the code path for such files. For each - <c>ebin</c> directory in the path, the <c>priv</c> directory is - also searched. The *.tool files contain the configuration data - for each web based tool.</p> - </section> - - <section> - <title>Starting WebTool</title> - <p>Start WebTool by calling the function <c>webtool:start/0</c> or - <c>webtool:start/2</c>. If <c>webtool:start/0</c> is used the - start page of WebTool is available at - <em>http://localhost:8888/</em> or - <em>http://127.0.0.1:8888/</em>, and the directory containing - the root directory for the webserver, is assumed to be - <c><![CDATA[webtool-<vsn>/priv]]></c>.</p> - <p>Use <c>webtool:start/2</c> if the default path for the root - directory, port, ip-number or server name can not be used. See - the Reference Manual for <seealso marker="webtool">webtool</seealso> for more information.</p> - <p>WebTool, with the default configuration as in <c>start/0</c>, - can also be started with the <c>start_webtool</c> script which - is available in the <c>priv</c> directory of the WebTool - application. See the Reference Manual for <seealso marker="start_webtool">start_webtool</seealso> for further - information about this script. For Windows users, the batch file - <c>start_webtool.bat</c> can be used for the same purpose.</p> - </section> - - <section> - <title>Using WebTool</title> - <p>Start WebTool and point the browser to the corresponding URL. - At the top of the page there is a frame with a link named - <em>WebTool</em>. Click that link and a page where it is - possible to start the available tools will appear in the main - frame.</p> - </section> - - <section> - <title>Start a web based tool</title> - <p>Click on the link labeled <em>WebTool</em> in the topmost frame, - select the checkbox for each tool to start and - click on the button labeled <em>Start</em>. A link to each tool - that WebTool succeeded to start will appear in the topmost frame.</p> - </section> - - <section> - <title>Stop a web based tool</title> - <p>Click on the link labeled <em>WebTool</em> in the topmost - frame. Select <em>Stop Tools</em> in the left frame. Select the - checkbox for each tool to stop and click on the button labeled - <em>Stop</em>.</p> - </section> - - <section> - <title>Develop new web based tools</title> - <p>WebTool can be used as a framework when developing new web based - tools.</p> - <p>A web based tool running under WebTool will typically consist of - three parts.</p> - <list type="bulleted"> - <item>A *.tool file which defines how WebTool can find the tool's - configuration data</item> - <item>The Erlang code generating the web interface to the tool (HTML - code)</item> - <item>The tool itself.</item> - </list> - <p>In most cases it is a good idea to separate the code for - creation of the html-pages and the code for the logic. This - increases the readability of the code and the logic might be - possible to reuse.</p> - - <section> - <title>The *.tool file</title> - <p>When WebTool starts it searches the current path for - <c>*.tool</c> files to find all available tools. The *.tool - file contains a version identifier and a list of tuples which - is the configuration data. The version identifier specifies - the *.tool file version, i.e. not the version of - webtool. Currently the only valid version is "1.2" and the - only valid configuration tag is - <c>config_func</c>. <c>config_func</c> specifies which - function WebTool must call to get further configuration data - for the tool. This means that a *.tool file generally must - look like this:</p> - <code type="none"> - {version,"1.2"}. - [{config_func,{Module,Function,Arguments}}]. </code> - <p><c>Module</c> is the name of the module where the callback - function is defined. <c>Function</c> is the name of the - callback function, and <c>Arguments</c> is the list of - arguments to the callback function.</p> - </section> - - <section> - <title>The configuration function</title> - <p>The *.tool file points out a configuration function. This - function must return a list of configuration parameters (see - the Reference Manual for <seealso marker="webtool">webtool</seealso>).</p> - <p>The <c>web_data</c> parameter is mandatory and it specifies - the name of the tool and the link to the tool's start - page. All other parameters are optional.</p> - <p>If the tool requires any processes to run, the <c>start</c> - parameter specifies the function that WebTool must call in - order to start the process(es).</p> - <p>The <c>alias</c> parameters are passed directly on to the - webserver (INETS). The webserver has three ways to create - dynamic web pages CGI, Eval Scheme and Erl Scheme. All tools - running under WebTool must use Erl Scheme.</p> - <p>Erl Scheme tries to resemble plain CGI. The big difference is - that Erl Scheme can only execute Erlang code. The code will - furthermore be executed on the same instance as the webserver.</p> - <p>An URL which calls an Erlang function with Erl Scheme can have - the following syntax:</p> - <code type="none"><![CDATA[ -http://Servername:Port/ErlScriptAlias/Mod/Func<?QueryString> ]]></code> - <p>An <c>alias</c> parameter in the configuration function can be - an ErlScriptAlias as used in the above URL. The definition of - an ErlScriptAlias shall be like this:</p> - <p><c>{alias,{erl_alias,Path,[Modules]}}</c>, e.g.</p> - <p><c>{alias,{erl_alias,"/testtool",[helloworld]}}</c></p> - <p>The following URL will then cause a call to the function - helloworld:helloworld/2 (if WebTool is started with default - settings i.e. servername "localhost" and port 8888):</p> - <p><c>http://localhost:8888/testtool/helloworld/helloworld</c></p> - <p>Note that the module <c>helloworld</c> must be in the code - path of the node running WebTool.</p> - <p>Functions that are called via the Erl Scheme must take two - arguments, <c>Environment</c> and <c>Input</c>. - </p> - <list type="bulleted"> - <item><c>Environment</c> is a list of key/value tuples.</item> - <item><c>Input</c> is the part of the URL after the "?", i.e. the - part of the URL containing name-value pairs. If the page was - called with the URL: - <br></br> -<c><![CDATA[http://localhost:8888/testtool/helloworld/helloworld?input1=one&input2=two]]></c> <br></br> -<c>Input</c> will be the string - <c><![CDATA["input1=one&input2=two"]]></c>. In the module - <c>httpd</c> in the INETS application there is a function - <c>parse_query</c> which will parse such a string and return - a list of key-value tuples.</item> - </list> - <p>An <c>alias</c> parameter in the configuration function can - also be a normal path alias. This can e.g. be used to point - out a directory where HTML files are stored. The following - definition states that the URL - <c>http://localhost:8888/mytool_home/</c> really points to the - directory <c>/usr/local/otp/lib/myapp-1.0/priv</c>:</p> - <p><c>{alias,{"/mytool_home","/usr/local/otp/lib/myapp-1.0/priv"}}</c></p> - <p>See the INETS documentation, especially the module - <c>mod_esi</c>, for a more in depth coverage of the Erl Scheme.</p> - </section> - - <section> - <title>A small example</title> - <p>A Hello World example that uses Erl Scheme would look like - this. Note that this example does not have a process running - and thus does not need a <c>start</c> parameter in the - configuration function. - </p> - <p><em>helloworld.erl:</em></p> - <pre> - -module(helloworld). - -export([config_data/0]). - -export([helloworld/2]). - - config_data()-> - {testtool, - [{web_data,{"TestTool","/testtool/helloworld/helloworld"}}, - {alias,{erl_alias,"/testtool",[helloworld]}}]}. - - helloworld(_Env,_Input)-> - [header(),html_header(),helloworld_body(),html_end()]. - - header() -> - header("text/html"). - - header(MimeType) -> - "Content-type: " ++ MimeType ++ "\r\n\r\n". - - html_header() -> - "<HTML> - <HEAD> - <TITLE>Hello world Example </TITLE> - </HEAD>\n". - - helloworld_body()-> - "<BODY>Hello World</BODY>". - - html_end()-> - "</HTML>". - </pre> - <p>To use this example with WebTool a *.tool file must be created - and added to a directory in the current path, e.g. the same - directory as the compiled <c>helloworld.beam</c>.</p> - <p><em>testtool.tool:</em></p> - <code type="none"> - {version,"1.2"}. - [{config_func, {helloworld,config_data,[]}}]. - </code> - <p>When <c>helloworld.erl</c> is compiled, start WebTool by - calling the function <c>webtool:start()</c> and point your - browser to <em>http://localhost:8888/</em>. Select WebTool in - the topmost frame and start TestTool from the web page. Click - on the link labeled <em>TestTool</em> in the topmost frame.</p> - </section> - </section> -</chapter> - diff --git a/lib/webtool/ebin/.gitignore b/lib/webtool/ebin/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/webtool/ebin/.gitignore +++ /dev/null diff --git a/lib/webtool/info b/lib/webtool/info deleted file mode 100644 index 4d8dc6f2cb..0000000000 --- a/lib/webtool/info +++ /dev/null @@ -1,2 +0,0 @@ -group: tools -short: A tool that simplifying the use of web based Erlang tools diff --git a/lib/webtool/priv/Makefile b/lib/webtool/priv/Makefile deleted file mode 100644 index 4963767a4d..0000000000 --- a/lib/webtool/priv/Makefile +++ /dev/null @@ -1,82 +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 Utvecklings AB. -# Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings -# AB. All Rights Reserved.'' -# -# $Id$ -# -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../vsn.mk -VSN=$(WEBTOOL_VSN) - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/webtool-$(VSN) - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- - -WEBSERVER_CONFIG_FILES = root/conf/mime.types - -HTDOCS_FILES = root/doc/index.html \ - root/doc/tool_management.html \ - root/doc/start_info.html - -ifeq ($(findstring win32,$(TARGET)),win32) -WIN32_SCRIPTS= bin/start_webtool.bat -else -WIN32_SCRIPTS= -endif -SCRIPTS = bin/start_webtool $(WIN32_SCRIPTS) - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -ERL_COMPILE_FLAGS += - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -debug opt: - -clean: - -docs: - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_spec: opt - $(INSTALL_DIR) "$(RELSYSDIR)/priv" - $(INSTALL_DIR) "$(RELSYSDIR)/priv/root" - $(INSTALL_DIR) "$(RELSYSDIR)/priv/root/conf" - $(INSTALL_DIR) "$(RELSYSDIR)/priv/root/doc" - $(INSTALL_DATA) $(HTDOCS_FILES) "$(RELSYSDIR)/priv/root/doc" - $(INSTALL_DATA) $(WEBSERVER_CONFIG_FILES) "$(RELSYSDIR)/priv/root/conf" - $(INSTALL_DIR) "$(RELSYSDIR)/priv/bin" - $(INSTALL_SCRIPT) $(SCRIPTS) "$(RELSYSDIR)/priv/bin" - -release_docs_spec: - - diff --git a/lib/webtool/priv/bin/start_webtool b/lib/webtool/priv/bin/start_webtool deleted file mode 100755 index e552fb5af0..0000000000 --- a/lib/webtool/priv/bin/start_webtool +++ /dev/null @@ -1,3 +0,0 @@ -#!/bin/sh - -erl -sname webtool -s webtool script_start $@ diff --git a/lib/webtool/priv/bin/start_webtool.bat b/lib/webtool/priv/bin/start_webtool.bat deleted file mode 100644 index cd16aa6200..0000000000 --- a/lib/webtool/priv/bin/start_webtool.bat +++ /dev/null @@ -1,2 +0,0 @@ -@ECHO OFF
-CALL erl -sname webtool -s webtool script_start %* -s erlang halt
\ No newline at end of file diff --git a/lib/webtool/priv/root/conf/mime.types b/lib/webtool/priv/root/conf/mime.types deleted file mode 100644 index 32f7cd853c..0000000000 --- a/lib/webtool/priv/root/conf/mime.types +++ /dev/null @@ -1,99 +0,0 @@ -# This is a comment. I love comments. - -application/activemessage -application/andrew-inset -application/applefile -application/atomicmail -application/dca-rft -application/dec-dx -application/mac-binhex40 hqx -application/mac-compactpro cpt -application/macwriteii -application/msword doc -application/news-message-id -application/news-transmission -application/octet-stream bin dms lha lzh exe class -application/oda oda -application/pdf pdf -application/postscript ai eps ps -application/powerpoint ppt -application/remote-printing -application/rtf rtf -application/slate -application/wita -application/wordperfect5.1 -application/x-bcpio bcpio -application/x-cdlink vcd -application/x-compress Z -application/x-cpio cpio -application/x-csh csh -application/x-director dcr dir dxr -application/x-dvi dvi -application/x-gtar gtar -application/x-gzip gz -application/x-hdf hdf -application/x-httpd-cgi cgi -application/x-koan skp skd skt skm -application/x-latex latex -application/x-mif mif -application/x-netcdf nc cdf -application/x-sh sh -application/x-shar shar -application/x-stuffit sit -application/x-sv4cpio sv4cpio -application/x-sv4crc sv4crc -application/x-tar tar -application/x-tcl tcl -application/x-tex tex -application/x-texinfo texinfo texi -application/x-troff t tr roff -application/x-troff-man man -application/x-troff-me me -application/x-troff-ms ms -application/x-ustar ustar -application/x-wais-source src -application/zip zip -audio/basic au snd -audio/mpeg mpga mp2 -audio/x-aiff aif aiff aifc -audio/x-pn-realaudio ram -audio/x-pn-realaudio-plugin rpm -audio/x-realaudio ra -audio/x-wav wav -chemical/x-pdb pdb xyz -image/gif gif -image/ief ief -image/jpeg jpeg jpg jpe -image/png png -image/tiff tiff tif -image/x-cmu-raster ras -image/x-portable-anymap pnm -image/x-portable-bitmap pbm -image/x-portable-graymap pgm -image/x-portable-pixmap ppm -image/x-rgb rgb -image/x-xbitmap xbm -image/x-xpixmap xpm -image/x-xwindowdump xwd -message/external-body -message/news -message/partial -message/rfc822 -multipart/alternative -multipart/appledouble -multipart/digest -multipart/mixed -multipart/parallel -text/html html htm -text/x-server-parsed-html shtml -text/plain txt -text/richtext rtx -text/tab-separated-values tsv -text/x-setext etx -text/x-sgml sgml sgm -video/mpeg mpeg mpg mpe -video/quicktime qt mov -video/x-msvideo avi -video/x-sgi-movie movie -x-conference/x-cooltalk ice -x-world/x-vrml wrl vrml diff --git a/lib/webtool/priv/root/doc/index.html b/lib/webtool/priv/root/doc/index.html deleted file mode 100644 index 9fbb143cc7..0000000000 --- a/lib/webtool/priv/root/doc/index.html +++ /dev/null @@ -1,11 +0,0 @@ -<HTML> -<HEAD> -<TITLE>Erlang WebTool</TITLE> -</HEAD> -<FRAMESET ROWS="60,*"> -<FRAME NAME="top1" SRC="webtool/webtool/started_tools"> -<FRAME NAME="app_frame" SRC="./start_info.html"> -</FRAMESET> -</HTML> - - diff --git a/lib/webtool/priv/root/doc/start_info.html b/lib/webtool/priv/root/doc/start_info.html deleted file mode 100644 index fcf44433f1..0000000000 --- a/lib/webtool/priv/root/doc/start_info.html +++ /dev/null @@ -1,28 +0,0 @@ -<HTML> -<HEAD> -</HEAD> -<BODY BGCOLOR="#FFFFFF"> -<TABLE WIDTH=100% HEIGHT=100%> -<TR VALIGN="middle"> -<TD ALIGN="center"> - -<TABLE WIDTH="60%"> -<TR> -<TD ALIGN="center"><FONT SIZE=6>Welcome <BR> to<BR> WebTool</FONT></TD> -</TR> - -<TR> -<TD><BR><BR><BR><BR> -</TD> -</TR> - -<TR> -<TD ALIGN="center">Click on the link WebTool on the top of the page, or <A HREF=tool_management.html>here</a> to start the Web based tools.</TD> -</TR> -</TABLE> - -</TD> -</TR> -</TABLE> -</BODY> -</HTML>
\ No newline at end of file diff --git a/lib/webtool/priv/root/doc/tool_management.html b/lib/webtool/priv/root/doc/tool_management.html deleted file mode 100644 index 19d9dbcb9e..0000000000 --- a/lib/webtool/priv/root/doc/tool_management.html +++ /dev/null @@ -1,9 +0,0 @@ -<HTML> -<HEAD> -<TITLE>Erlang WebTool </TITLE> -</HEAD> -<FRAMESET COLS="200,*"> -<FRAME NAME="left" SRC="/webtool/webtool/toolbar"> -<FRAME NAME="right" SRC="/webtool/webtool/start_tools"> -</FRAMESET> - diff --git a/lib/webtool/src/webtool.app.src b/lib/webtool/src/webtool.app.src deleted file mode 100644 index 6b9750c2b4..0000000000 --- a/lib/webtool/src/webtool.app.src +++ /dev/null @@ -1,28 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2009. 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% -%% -{application,webtool, - [{description,"Toolbar lookalike for the web"}, - {vsn,"%VSN%"}, - {modules,[webtool,webtool_sup]}, - {registered,[web_tool,websup]}, - {applications,[kernel,stdlib]}, - {runtime_dependencies, ["stdlib-2.0","observer-2.0","kernel-3.0", - "inets-5.10","erts-6.0"]}]}. - diff --git a/lib/webtool/src/webtool.appup.src b/lib/webtool/src/webtool.appup.src deleted file mode 100644 index 1394d0d6d5..0000000000 --- a/lib/webtool/src/webtool.appup.src +++ /dev/null @@ -1,22 +0,0 @@ -%% -*- erlang -*- -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2014. 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% -{"%VSN%", - [{<<".*">>,[{restart_application, webtool}]}], - [{<<".*">>,[{restart_application, webtool}]}] -}. diff --git a/lib/webtool/src/webtool.erl b/lib/webtool/src/webtool.erl deleted file mode 100644 index 80dad53f8f..0000000000 --- a/lib/webtool/src/webtool.erl +++ /dev/null @@ -1,1208 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2010. 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(webtool). --behaviour(gen_server). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% The general idea is: %% -%% %% -%% %% -%% 1. Scan through the path for *.tool files and find all the web %% -%% based tools. Query each tool for configuration data. %% -%% 2. Add Alias for Erlscript and html for each tool to %% -%% the webserver configuration data. %% -%% 3. Start the webserver. %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%% API functions --export([start/0, start/2, stop/0]). - -%% Starting Webtool from a shell script --export([script_start/0, script_start/1]). - -%% Web api --export([started_tools/2, toolbar/2, start_tools/2, stop_tools/2]). - -%% API against other tools --export([is_localhost/0]). - -%% Debug export s --export([get_tools1/1]). --export([debug/1, stop_debug/0, debug_app/1]). - -%% gen_server callbacks --export([init/1, handle_call/3, handle_cast/2, handle_info/2, - terminate/2, code_change/3]). - --include_lib("kernel/include/file.hrl"). --include_lib("stdlib/include/ms_transform.hrl"). - --record(state,{priv_dir,app_data,supvis,web_data,started=[]}). - --define(MAX_NUMBER_OF_WEBTOOLS,256). --define(DEFAULT_PORT,8888).% must be >1024 or the user must be root on unix --define(DEFAULT_ADDR,{127,0,0,1}). - --define(WEBTOOL_ALIAS,{webtool,[{alias,{erl_alias,"/webtool",[webtool]}}]}). --define(HEADER,"Pragma:no-cache\r\n Content-type: text/html\r\n\r\n"). --define(HTML_HEADER,"<HTML>\r\n<HEAD>\r\n<TITLE>WebTool</TITLE>\r\n</HEAD>\r\n<BODY BGCOLOR=\"#FFFFFF\">\r\n"). --define(HTML_HEADER_RELOAD,"<HTML>\r\n<HEAD>\r\n<TITLE>WebTool - </TITLE>\r\n</HEAD>\r\n - <BODY BGCOLOR=\"#FFFFFF\" onLoad=reloadCompiledList()>\r\n"). - --define(HTML_END,"</BODY></HTML>"). - --define(SEND_URL_TIMEOUT,5000). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% For debugging only. %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Start tracing with -%% debug(Functions). -%% Functions = local | global | FunctionList -%% FunctionList = [Function] -%% Function = {FunctionName,Arity} | FunctionName | -%% {Module, FunctionName, Arity} | {Module,FunctionName} -debug(F) -> - ttb:tracer(all,[{file,"webtool.trc"}]), % tracing all nodes - ttb:p(all,[call,timestamp]), - MS = [{'_',[],[{return_trace},{message,{caller}}]}], - tp(F,MS), - ttb:ctp(?MODULE,stop_debug), % don't want tracing of the stop_debug func - ok. -tp(local,MS) -> % all functions - ttb:tpl(?MODULE,MS); -tp(global,MS) -> % all exported functions - ttb:tp(?MODULE,MS); -tp([{M,F,A}|T],MS) -> % Other module - ttb:tpl(M,F,A,MS), - tp(T,MS); -tp([{M,F}|T],MS) when is_atom(F) -> % Other module - ttb:tpl(M,F,MS), - tp(T,MS); -tp([{F,A}|T],MS) -> % function/arity - ttb:tpl(?MODULE,F,A,MS), - tp(T,MS); -tp([F|T],MS) -> % function - ttb:tpl(?MODULE,F,MS), - tp(T,MS); -tp([],_MS) -> - ok. -stop_debug() -> - ttb:stop([format]). - -debug_app(Mod) -> - ttb:tracer(all,[{file,"webtool_app.trc"},{handler,{fun out/4,true}}]), - ttb:p(all,[call,timestamp]), - MS = [{'_',[],[{return_trace},{message,{caller}}]}], - ttb:tp(Mod,MS), - ok. - -out(_,{trace_ts,Pid,call,MFA={M,F,A},{W,_,_},TS},_,S) - when W==webtool;W==mod_esi-> - io:format("~w: (~p)~ncall ~s~n", [TS,Pid,ffunc(MFA)]), - [{M,F,length(A)}|S]; -out(_,{trace_ts,Pid,return_from,MFA,R,TS},_,[MFA|S]) -> - io:format("~w: (~p)~nreturned from ~s -> ~p~n", [TS,Pid,ffunc(MFA),R]), - S; -out(_,_,_,_) -> - ok. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% Functions called via script. %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -script_start() -> - usage(), - halt(). -script_start([App]) -> - DefaultBrowser = - case os:type() of - {win32,_} -> iexplore; - _ -> firefox - end, - script_start([App,DefaultBrowser]); -script_start([App,Browser]) -> - io:format("Starting webtool...\n"), - start(), - AvailableApps = get_applications(), - {OSType,_} = os:type(), - case lists:keysearch(App,1,AvailableApps) of - {value,{App,StartPage}} -> - io:format("Starting ~w...\n",[App]), - start_tools([],"app=" ++ atom_to_list(App)), - PortStr = integer_to_list(get_port()), - Url = case StartPage of - "/" ++ Page -> - "http://localhost:" ++ PortStr ++ "/" ++ Page; - _ -> - "http://localhost:" ++ PortStr ++ "/" ++ StartPage - end, - case Browser of - none -> - ok; - iexplore when OSType == win32-> - io:format("Starting internet explorer...\n"), - {ok,R} = win32reg:open(""), - Key="\\local_machine\\SOFTWARE\\Microsoft\\IE Setup\\Setup", - win32reg:change_key(R,Key), - {ok,Val} = win32reg:value(R,"Path"), - IExplore=filename:join(win32reg:expand(Val),"iexplore.exe"), - os:cmd("\"" ++ IExplore ++ "\" " ++ Url); - _ when OSType == win32 -> - io:format("Starting ~w...\n",[Browser]), - os:cmd("\"" ++ atom_to_list(Browser) ++ "\" " ++ Url); - B when B==firefox; B==mozilla -> - io:format("Sending URL to ~w...",[Browser]), - BStr = atom_to_list(Browser), - SendCmd = BStr ++ " -raise -remote \'openUrl(" ++ - Url ++ ")\'", - Port = open_port({spawn,SendCmd},[exit_status]), - receive - {Port,{exit_status,0}} -> - io:format("done\n"), - ok; - {Port,{exit_status,_Error}} -> - io:format(" not running, starting ~w...\n", - [Browser]), - os:cmd(BStr ++ " " ++ Url), - ok - after ?SEND_URL_TIMEOUT -> - io:format(" failed, starting ~w...\n",[Browser]), - erlang:port_close(Port), - os:cmd(BStr ++ " " ++ Url) - end; - _ -> - io:format("Starting ~w...\n",[Browser]), - os:cmd(atom_to_list(Browser) ++ " " ++ Url) - end, - ok; - false -> - stop(), - io:format("\n{error,{unknown_app,~p}}\n",[App]), - halt() - end. - -usage() -> - io:format("Starting webtool...\n"), - start(), - Apps = lists:map(fun({A,_}) -> A end,get_applications()), - io:format( - "\nUsage: start_webtool application [ browser ]\n" - "\nAvailable applications are: ~p\n" - "Default browser is \'iexplore\' (Internet Explorer) on Windows " - "or else \'firefox\'\n", - [Apps]), - stop(). - - -get_applications() -> - gen_server:call(web_tool,get_applications). - -get_port() -> - gen_server:call(web_tool,get_port). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% Api functions to the genserver. %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%---------------------------------------------------------------------- -% -%---------------------------------------------------------------------- - -start()-> - start(standard_path,standard_data). - -start(Path,standard_data)-> - case get_standard_data() of - {error,Reason} -> - {error,Reason}; - Data -> - start(Path,Data) - end; - -start(standard_path,Data)-> - Path=get_path(), - start(Path,Data); - -start(Path,Port) when is_integer(Port)-> - Data = get_standard_data(Port), - start(Path,Data); - -start(Path,Data0)-> - Data = Data0 ++ rest_of_standard_data(), - gen_server:start({local,web_tool},webtool,{Path,Data},[]). - -stop()-> - gen_server:call(web_tool,stoppit). - -%---------------------------------------------------------------------- -%Web Api functions called by the web -%---------------------------------------------------------------------- -started_tools(Env,Input)-> - gen_server:call(web_tool,{started_tools,Env,Input}). - -toolbar(Env,Input)-> - gen_server:call(web_tool,{toolbar,Env,Input}). - -start_tools(Env,Input)-> - gen_server:call(web_tool,{start_tools,Env,Input}). - -stop_tools(Env,Input)-> - gen_server:call(web_tool,{stop_tools,Env,Input}). -%---------------------------------------------------------------------- -%Support API for other tools -%---------------------------------------------------------------------- - -is_localhost()-> - gen_server:call(web_tool,is_localhost). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%%The gen_server callback functions that builds the webbpages %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -handle_call(get_applications,_,State)-> - MS = ets:fun2ms(fun({Tool,{web_data,{_,Start}}}) -> {Tool,Start} end), - Tools = ets:select(State#state.app_data,MS), - {reply,Tools,State}; - -handle_call(get_port,_,State)-> - {value,{port,Port}}=lists:keysearch(port,1,State#state.web_data), - {reply,Port,State}; - -handle_call({started_tools,_Env,_Input},_,State)-> - {reply,started_tools_page(State),State}; - -handle_call({toolbar,_Env,_Input},_,State)-> - {reply,toolbar(),State}; - -handle_call({start_tools,Env,Input},_,State)-> - {NewState,Page}=start_tools_page(Env,Input,State), - {reply,Page,NewState}; - -handle_call({stop_tools,Env,Input},_,State)-> - {NewState,Page}=stop_tools_page(Env,Input,State), - {reply,Page,NewState}; - -handle_call(stoppit,_From,Data)-> - {stop,normal,ok,Data}; - -handle_call(is_localhost,_From,Data)-> - Result=case proplists:get_value(bind_address, Data#state.web_data) of - ?DEFAULT_ADDR -> - true; - _IpNumber -> - false - end, - {reply,Result,Data}. - - -handle_info(_Message,State)-> - {noreply,State}. - -handle_cast(_Request,State)-> - {noreply,State}. - -code_change(_,State,_)-> - {ok,State}. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% -% The other functions needed by the gen_server behaviour -% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%---------------------------------------------------------------------- -% Start the gen_server -%---------------------------------------------------------------------- -init({Path,Config})-> - case filelib:is_dir(Path) of - true -> - {ok, Table} = get_tool_files_data(), - insert_app(?WEBTOOL_ALIAS, Table), - case webtool_sup:start_link() of - {ok, Pid} -> - case start_webserver(Table, Path, Config) of - {ok, _} -> - print_url(Config), - {ok,#state{priv_dir=Path, - app_data=Table, - supvis=Pid, - web_data=Config}}; - {error, Error} -> - {stop, {error, Error}} - end; - Error -> - {stop,Error} - end; - false -> - {stop, {error, error_dir}} - end. - -terminate(_Reason,Data)-> - %%shut down the webbserver - shutdown_server(Data), - %%Shutdown the different tools that are started with application:start - shutdown_apps(Data), - %%Shutdown the supervisor and its children will die - shutdown_supervisor(Data), - ok. - -print_url(ConfigData)-> - Server=proplists:get_value(server_name,ConfigData,"undefined"), - Port=proplists:get_value(port,ConfigData,"undefined"), - {A,B,C,D}=proplists:get_value(bind_address,ConfigData,"undefined"), - io:format("WebTool is available at http://~s:~w/~n",[Server,Port]), - io:format("Or http://~w.~w.~w.~w:~w/~n",[A,B,C,D,Port]). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% -% begin build the pages -% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%---------------------------------------------------------------------- -%The page that shows the started tools -%---------------------------------------------------------------------- -started_tools_page(State)-> - [?HEADER,?HTML_HEADER,started_tools(State),?HTML_END]. - -toolbar()-> - [?HEADER,?HTML_HEADER,toolbar_page(),?HTML_END]. - - -start_tools_page(_Env,Input,State)-> - %%io:format("~n======= ~n ~p ~n============~n",[Input]), - case get_tools(Input) of - {tools,Tools}-> - %%io:format("~n======= ~n ~p ~n============~n",[Tools]), - {ok,NewState}=handle_apps(Tools,State,start), - {NewState,[?HEADER,?HTML_HEADER_RELOAD,reload_started_apps(), - show_unstarted_apps(NewState),?HTML_END]}; - _ -> - {State,[?HEADER,?HTML_HEADER,show_unstarted_apps(State),?HTML_END]} - end. - -stop_tools_page(_Env,Input,State)-> - case get_tools(Input) of - {tools,Tools}-> - {ok,NewState}=handle_apps(Tools,State,stop), - {NewState,[?HEADER,?HTML_HEADER_RELOAD,reload_started_apps(), - show_started_apps(NewState),?HTML_END]}; - _ -> - {State,[?HEADER,?HTML_HEADER,show_started_apps(State),?HTML_END]} - end. - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% Functions that start and config the webserver -%% 1. Collect the config data -%% 2. Start webserver -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%---------------------------------------------------------------------- -% Start the webserver -%---------------------------------------------------------------------- -start_webserver(Data,Path,Config)-> - case get_conf_data(Data,Path,Config) of - {ok,Conf_data}-> - %%io:format("Conf_data: ~p~n",[Conf_data]), - start_server(Conf_data); - {error,Error} -> - {error,{error_server_conf_file,Error}} - end. - -start_server(Conf_data)-> - case inets:start(httpd, Conf_data, stand_alone) of - {ok,Pid}-> - {ok,Pid}; - Error-> - {error,{server_error,Error}} - end. - -%---------------------------------------------------------------------- -% Create config data for the webserver -%---------------------------------------------------------------------- -get_conf_data(Data,Path,Config)-> - Aliases=get_aliases(Data), - ServerRoot = filename:join([Path,"root"]), - MimeTypesFile = filename:join([ServerRoot,"conf","mime.types"]), - case httpd_conf:load_mime_types(MimeTypesFile) of - {ok,MimeTypes} -> - Config1 = Config ++ Aliases, - Config2 = [{server_root,ServerRoot}, - {document_root,filename:join([Path,"root/doc"])}, - {mime_types,MimeTypes} | - Config1], - {ok,Config2}; - Error -> - Error - end. - -%---------------------------------------------------------------------- -% Control the path for *.tools files -%---------------------------------------------------------------------- -get_tool_files_data()-> - Tools=get_tools1(code:get_path()), - %%io:format("Data : ~p ~n",[Tools]), - get_file_content(Tools). - -%---------------------------------------------------------------------- -%Control that the data in the file really is erlang terms -%---------------------------------------------------------------------- -get_file_content(Tools)-> - Get_data=fun({tool,ToolData}) -> - %%io:format("Data : ~p ~n",[ToolData]), - case proplists:get_value(config_func,ToolData) of - {M,F,A}-> - case catch apply(M,F,A) of - {'EXIT',_} -> - bad_data; - Data when is_tuple(Data) -> - Data; - _-> - bad_data - end; - _ -> - bad_data - end - end, - insert_file_content([X ||X<-lists:map(Get_data,Tools),X/=bad_data]). - -%---------------------------------------------------------------------- -%Insert the data from the file in to the ets:table -%---------------------------------------------------------------------- -insert_file_content(Content)-> - Table=ets:new(app_data,[bag]), - lists:foreach(fun(X)-> - insert_app(X,Table) - end,Content), - {ok,Table}. - -%---------------------------------------------------------------------- -%Control that we got a a tuple of a atom and a list if so add the -%elements in the list to the ets:table -%---------------------------------------------------------------------- -insert_app({Name,Key_val_list},Table) when is_list(Key_val_list),is_atom(Name)-> - %%io:format("ToolData: ~p: ~p~n",[Name,Key_val_list]), - lists:foreach( - fun({alias,{erl_alias,Alias,Mods}}) -> - Key_val = {erl_script_alias,{Alias,Mods}}, - %%io:format("Insert: ~p~n",[Key_val]), - ets:insert(Table,{Name,Key_val}); - (Key_val_pair)-> - %%io:format("Insert: ~p~n",[Key_val_pair]), - ets:insert(Table,{Name,Key_val_pair}) - end, - Key_val_list); - -insert_app(_,_)-> - ok. - -%---------------------------------------------------------------------- -% Select all the alias in the database -%---------------------------------------------------------------------- -get_aliases(Data)-> - MS = ets:fun2ms(fun({_,{erl_script_alias,Alias}}) -> - {erl_script_alias,Alias}; - ({_,{alias,Alias}}) -> - {alias,Alias} - end), - ets:select(Data,MS). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% Helper functions %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -get_standard_data(Port)-> - [ - {port,Port}, - {bind_address,?DEFAULT_ADDR}, - {server_name,"localhost"} - ]. - -get_standard_data()-> - case get_free_port(?DEFAULT_PORT,?MAX_NUMBER_OF_WEBTOOLS) of - {error,Reason} -> {error,Reason}; - Port -> - [ - {port,Port}, - {bind_address,?DEFAULT_ADDR}, - {server_name,"localhost"} - ] - end. - -get_free_port(_Port,0) -> - {error,no_free_port_found}; -get_free_port(Port,N) -> - case gen_tcp:connect("localhost",Port,[]) of - {error, _Reason} -> - Port; - {ok,Sock} -> - gen_tcp:close(Sock), - get_free_port(Port+1,N-1) - end. - -rest_of_standard_data() -> - [ - %% Do not allow the server to be crashed by malformed http-request - {max_header_siz,1024}, - {max_header_action,reply414}, - %% Go on a straight ip-socket - {com_type,ip_comm}, - %% Do not change the order of these module names!! - {modules,[mod_alias, - mod_auth, - mod_esi, - mod_actions, - mod_cgi, - mod_include, - mod_dir, - mod_get, - mod_head, - mod_log, - mod_disk_log]}, - {directory_index,["index.html"]}, - {default_type,"text/plain"} - ]. - - -get_path()-> - code:priv_dir(webtool). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% These functions is used to shutdown the webserver -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%---------------------------------------------------------------------- -% Shut down the webbserver -%---------------------------------------------------------------------- -shutdown_server(State)-> - {Addr,Port} = get_addr_and_port(State#state.web_data), - inets:stop(httpd,{Addr,Port}). - -get_addr_and_port(Config) -> - Addr = proplists:get_value(bind_address,Config,?DEFAULT_ADDR), - Port = proplists:get_value(port,Config,?DEFAULT_PORT), - {Addr,Port}. - -%---------------------------------------------------------------------- -% Select all apps in the table and close them -%---------------------------------------------------------------------- -shutdown_apps(State)-> - Data=State#state.app_data, - MS = ets:fun2ms(fun({_,{start,HowToStart}}) -> HowToStart end), - lists:foreach(fun(Start_app)-> - stop_app(Start_app) - end, - ets:select(Data,MS)). - -%---------------------------------------------------------------------- -%Shuts down the supervisor that supervises tools that is not -%Designed as applications -%---------------------------------------------------------------------- -shutdown_supervisor(State)-> - %io:format("~n==================~n"), - webtool_sup:stop(State#state.supvis). - %io:format("~n==================~n"). - -%---------------------------------------------------------------------- -%close the individual apps. -%---------------------------------------------------------------------- -stop_app({child,_Real_name})-> - ok; - -stop_app({app,Real_name})-> - application:stop(Real_name); - -stop_app({func,_Start,Stop})-> - case Stop of - {M,F,A} -> - catch apply(M,F,A); - _NoStop -> - ok - end. - - - - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% These functions creates the webpage where the user can select if -%% to start apps or to stop apps -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -toolbar_page()-> - "<TABLE> - <TR> - <TD> - <B>Select Action</B> - </TD> - </TR> - <TR> - <TD> - <A HREF=\"./start_tools\" TARGET=right> Start Tools</A> - </TD> - </TR> - <TR> - <TD> - <A HREF=\"./stop_tools\" TARGET=right> Stop Tools</A> - </TD> - </TR> - </TABLE>". -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% These functions creates the webbpage that shows the started apps -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%---------------------------------------------------------------------- -% started_tools(State)->String (html table) -% State is a record of type state -%---------------------------------------------------------------------- -started_tools(State)-> - Names=get_started_apps(State#state.app_data,State#state.started), - "<TABLE BORDER=1 WIDTH=100%> - "++ make_rows(Names,[],0) ++" - </TABLE>". -%---------------------------------------------------------------------- -%get_started_apps(Data,Started)-> [{web_name,link}] -%selects the started apps from the ets table of apps. -%---------------------------------------------------------------------- - -get_started_apps(Data,Started)-> - SelectData=fun({Name,Link}) -> - {Name,Link} - end, - MS = lists:map(fun(A) -> {{A,{web_data,'$1'}},[],['$1']} end,Started), - - [{"WebTool","/tool_management.html"} | - [SelectData(X) || X <- ets:select(Data,MS)]]. - -%---------------------------------------------------------------------- -% make_rows(List,Result,Fields)-> String (The rows of a htmltable -% List a list of tupler discibed above -% Result an accumulator for the result -% Field, counter that counts the number of cols in each row. -%---------------------------------------------------------------------- -make_rows([],Result,Fields)-> - Result ++ fill_out(Fields); -make_rows([Data|Paths],Result,Field)when Field==0-> - make_rows(Paths,Result ++ "<TR>" ++ make_field(Data),Field+1); - -make_rows([Path|Paths],Result,Field)when Field==4-> - make_rows(Paths,Result ++ make_field(Path) ++ "</TR>",0); - -make_rows([Path|Paths],Result,Field)-> - make_rows(Paths,Result ++ make_field(Path),Field+1). - -%---------------------------------------------------------------------- -% make_fields(Path)-> String that is a field i a html table -% Path is a name url tuple {Name,url} -%---------------------------------------------------------------------- -make_field(Path)-> - "<TD WIDTH=20%>" ++ get_name(Path) ++ "</TD>". - - -%---------------------------------------------------------------------- -%get_name({Nae,Url})->String that represents a <A> tag in html. -%---------------------------------------------------------------------- -get_name({Name,Url})-> - "<A HREF=\"" ++ Url ++ "\" TARGET=app_frame>" ++ Name ++ "</A>". - - -%---------------------------------------------------------------------- -% fill_out(Nr)-> String, that represent Nr fields in a html-table. -%---------------------------------------------------------------------- -fill_out(Nr)when Nr==0-> - []; -fill_out(Nr)when Nr==4-> - "<TD WIDTH=\"20%\" > </TD></TR>"; - -fill_out(Nr)-> - "<TD WIDTH=\"20%\"> </TD>" ++ fill_out(Nr+1). - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%%These functions starts applicatons and builds the page showing tools -%%to start -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%---------------------------------------------------------------------- -%Controls whether the user selected a tool to start -%---------------------------------------------------------------------- -get_tools(Input)-> - case httpd:parse_query(Input) of - []-> - no_tools; - Tools-> - FormatData=fun({_Name,Data}) -> list_to_atom(Data) end, - SelectData= - fun({Name,_Data}) -> string:equal(Name,"app") end, - {tools,[FormatData(X)||X<-Tools,SelectData(X)]} - end. - -%---------------------------------------------------------------------- -% Selects the data to start the applications the user has ordered -% starting of -%---------------------------------------------------------------------- -handle_apps([],State,_Cmd)-> - {ok,State}; - -handle_apps([Tool|Tools],State,Cmd)-> - case ets:match_object(State#state.app_data,{Tool,{start,'_'}}) of - []-> - Started = case Cmd of - start -> - [Tool|State#state.started]; - stop -> - lists:delete(Tool,State#state.started) - end, - {ok,#state{priv_dir=State#state.priv_dir, - app_data=State#state.app_data, - supvis=State#state.supvis, - web_data=State#state.web_data, - started=Started}}; - ToStart -> - case handle_apps2(ToStart,State,Cmd) of - {ok,NewState}-> - handle_apps(Tools,NewState,Cmd); - _-> - handle_apps(Tools,State,Cmd) - end - end. - -%---------------------------------------------------------------------- -%execute every start or stop data about a tool. -%---------------------------------------------------------------------- -handle_apps2([{Name,Start_data}],State,Cmd)-> - case handle_app({Name,Start_data},State#state.app_data,State#state.supvis,Cmd) of - ok-> - Started = case Cmd of - start -> - [Name|State#state.started]; - stop -> - - lists:delete(Name,State#state.started) - end, - {ok,#state{priv_dir=State#state.priv_dir, - app_data=State#state.app_data, - supvis=State#state.supvis, - web_data=State#state.web_data, - started=Started}}; - _-> - error - end; - -handle_apps2([{Name,Start_data}|Rest],State,Cmd)-> - case handle_app({Name,Start_data},State#state.app_data,State#state.supvis,Cmd)of - ok-> - handle_apps2(Rest,State,Cmd); - _-> - error - end. - - -%---------------------------------------------------------------------- -% Handle start and stop of applications -%---------------------------------------------------------------------- - -handle_app({Name,{start,{func,Start,Stop}}},Data,_Pid,Cmd)-> - Action = case Cmd of - start -> - Start; - _ -> - Stop - end, - case Action of - {M,F,A} -> - case catch apply(M,F,A) of - {'EXIT',_} = Exit-> - %%! Here the tool disappears from the webtool interface!! - io:format("\n=======ERROR (webtool, line ~w) =======\n" - "Could not start application \'~p\'\n\n" - "~w:~w(~s) ->\n" - "~p\n\n", - [?LINE,Name,M,F,format_args(A),Exit]), - ets:delete(Data,Name); - _OK-> - ok - end; - _NoStart -> - ok - end; - - -handle_app({Name,{start,{child,ChildSpec}}},Data,Pid,Cmd)-> - case Cmd of - start -> - case catch supervisor:start_child(Pid,ChildSpec) of - {ok,_}-> - ok; - {ok,_,_}-> - ok; - {error,Reason}-> - %%! Here the tool disappears from the webtool interface!! - io:format("\n=======ERROR (webtool, line ~w) =======\n" - "Could not start application \'~p\'\n\n" - "supervisor:start_child(~p,~p) ->\n" - "~p\n\n", - [?LINE,Name,Pid,ChildSpec,{error,Reason}]), - ets:delete(Data,Name); - Error -> - %%! Here the tool disappears from the webtool interface!! - io:format("\n=======ERROR (webtool, line ~w) =======\n" - "Could not start application \'~p\'\n\n" - "supervisor:start_child(~p,~p) ->\n" - "~p\n\n", - [?LINE,Name,Pid,ChildSpec,Error]), - ets:delete(Data,Name) - end; - stop -> - case catch supervisor:terminate_child(websup,element(1,ChildSpec)) of - ok -> - supervisor:delete_child(websup,element(1,ChildSpec)); - _ -> - error - end - end; - - - -handle_app({Name,{start,{app,Real_name}}},Data,_Pid,Cmd)-> - case Cmd of - start -> - case application:start(Real_name,temporary) of - ok-> - io:write(Name), - ok; - {error,{already_started,_}}-> - %% Remove it from the database so we dont start - %% anything already started - ets:match_delete(Data,{Name,{start,{app,Real_name}}}), - ok; - {error,_Reason}=Error-> - %%! Here the tool disappears from the webtool interface!! - io:format("\n=======ERROR (webtool, line ~w) =======\n" - "Could not start application \'~p\'\n\n" - "application:start(~p,~p) ->\n" - "~p\n\n", - [?LINE,Name,Real_name,temporary,Error]), - ets:delete(Data,Name) - end; - - stop -> - application:stop(Real_name) - end; - -%---------------------------------------------------------------------- -% If the data is incorrect delete the app -%---------------------------------------------------------------------- -handle_app({Name,Incorrect},Data,_Pid,Cmd)-> - %%! Here the tool disappears from the webtool interface!! - io:format("\n=======ERROR (webtool, line ~w) =======\n" - "Could not ~w application \'~p\'\n\n" - "Incorrect data: ~p\n\n", - [?LINE,Cmd,Name,Incorrect]), - ets:delete(Data,Name). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% this functions creates the page that shows the unstarted tools %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -reload_started_apps()-> - "<script> - function reloadCompiledList() - { - parent.parent.top1.document.location.href=\"/webtool/webtool/started_tools\"; - } - </script>". - -show_unstarted_apps(State)-> - "<TABLE HEIGHT=100% WIDTH=100% BORDER=0> - <TR HEIGHT=80%><TD ALIGN=\"center\" VALIGN=\"middle\"> - <FORM NAME=\"stop_apps\" ACTION=\"/webtool/webtool/start_tools\" > - <TABLE BORDER=1 WIDTH=60%> - <TR BGCOLOR=\"#8899AA\"> - <TD ALIGN=CENTER COLSPAN=2><FONT SIZE=4>Available Tools<FONT></TD> - </TR> - <TR> - <TD WIDTH=50%> - <TABLE BORDER=0> - "++ list_available_apps(State)++" - <TR><TD COLSPAN=2> </TD></TR> - <TR> - <TD COLSPAN=2 ALIGN=\"center\"> - <INPUT TYPE=submit VALUE=\"Start\"> - </TD> - </TR> - </TABLE> - </TD> - <TD> - To Start a Tool: - <UL> - <LI>Select the - checkbox for each tool to - start.</LI> - <LI>Click on the - button marked <EM>Start</EM>.</LI></UL> - </TD> - </TR> - </TABLE> - </FORM> - </TD></TR> - <TR><TD> </TD></TR> - </TABLE>". - - - -list_available_apps(State)-> - MS = ets:fun2ms(fun({Tool,{web_data,{Name,_}}}) -> {Tool,Name} end), - Unstarted_apps= - lists:filter( - fun({Tool,_})-> - false==lists:member(Tool,State#state.started) - end, - ets:select(State#state.app_data,MS)), - case Unstarted_apps of - []-> - "<TR><TD>All tools are started</TD></TR>"; - _-> - list_apps(Unstarted_apps) - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% these functions creates the page that shows the started apps %% -%% the user can select to shutdown %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -show_started_apps(State)-> - "<TABLE HEIGHT=100% WIDTH=100% BORDER=0> - <TR HEIGHT=80%><TD ALIGN=\"center\" VALIGN=\"middle\"> - <FORM NAME=\"stop_apps\" ACTION=\"/webtool/webtool/stop_tools\" > - <TABLE BORDER=1 WIDTH=60%> - <TR BGCOLOR=\"#8899AA\"> - <TD ALIGN=CENTER COLSPAN=2><FONT SIZE=4>Started Tools<FONT></TD> - </TR> - <TR> - <TD WIDTH=50%> - <TABLE BORDER=0> - "++ list_started_apps(State)++" - <TR><TD COLSPAN=2> </TD></TR> - <TR> - <TD COLSPAN=2 ALIGN=\"center\"> - <INPUT TYPE=submit VALUE=\"Stop\"> - </TD> - </TR> - </TABLE> - </TD> - <TD> - Stop a Tool: - <UL> - <LI>Select the - checkbox for each tool to - stop.</LI> - <LI>Click on the - button marked <EM>Stop</EM>.</LI></UL> - </TD> - </TR> - </TABLE> - </FORM> - </TD></TR> - <TR><TD> </TD></TR> - </TABLE>". - -list_started_apps(State)-> - MS = lists:map(fun(A) -> {{A,{web_data,{'$1','_'}}},[],[{{A,'$1'}}]} end, - State#state.started), - Started_apps= ets:select(State#state.app_data,MS), - case Started_apps of - []-> - "<TR><TD>No tool is started yet.</TD></TR>"; - _-> - list_apps(Started_apps) - end. - - -list_apps(Apps) -> - lists:map(fun({Tool,Name})-> - "<TR><TD> - <INPUT TYPE=\"checkbox\" NAME=\"app\" VALUE=\"" - ++ atom_to_list(Tool) ++ "\"> - " ++ Name ++ " - </TD></TR>" - end, - Apps). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% Collecting the data from the *.tool files %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%---------------------------------------- -% get_tools(Dirs) => [{M,F,A},{M,F,A}...{M,F,A}] -% Dirs - [string()] Directory names -% Calls get_tools2/2 recursively for a number of directories -% to retireve the configuration data for the web based tools. -%---------------------------------------- -get_tools1(Dirs)-> - get_tools1(Dirs,[]). - -get_tools1([Dir|Rest],Data) when is_list(Dir) -> - Tools=case filename:basename(Dir) of - %% Dir is an 'ebin' directory, check in '../priv' as well - "ebin" -> - [get_tools2(filename:join(filename:dirname(Dir),"priv")) | - get_tools2(Dir)]; - _ -> - get_tools2(Dir) - end, - get_tools1(Rest,[Tools|Data]); - -get_tools1([],Data) -> - lists:flatten(Data). - -%---------------------------------------- -% get_tools2(Directory) => DataList -% DataList : [WebTuple]|[] -% WebTuple: {tool,[{web,M,F,A}]} -% -%---------------------------------------- -get_tools2(Dir)-> - get_tools2(tool_files(Dir),[]). - -get_tools2([ToolFile|Rest],Data) -> - case get_tools3(ToolFile) of - {tool,WebData} -> - get_tools2(Rest,[{tool,WebData}|Data]); - {error,_Reason} -> - get_tools2(Rest,Data); - nodata -> - get_tools2(Rest,Data) - end; - -get_tools2([],Data) -> - Data. - -%---------------------------------------- -% get_tools3(ToolFile) => {ok,Tool}|{error,Reason}|nodata -% Tool: {tool,[KeyValTuple]} -% ToolFile - string() A .tool file -% Now we have the file get the data and sort it out -%---------------------------------------- -get_tools3(ToolFile) -> - case file:consult(ToolFile) of - {error,open} -> - {error,nofile}; - {error,read} -> - {error,format}; - {ok,[{version,"1.2"},ToolInfo]} when is_list(ToolInfo)-> - webdata(ToolInfo); - {ok,[{version,_Vsn},_Info]} -> - {error,old_version}; - {ok,_Other} -> - {error,format} - end. - - -%---------------------------------------------------------------------- -% webdata(TupleList)-> ToolTuple| nodata -% ToolTuple: {tool,[{config_func,{M,F,A}}]} -% -% There are a little unneccesary work in this format but it is extendable -%---------------------------------------------------------------------- -webdata(TupleList)-> - case proplists:get_value(config_func,TupleList,nodata) of - {M,F,A} -> - {tool,[{config_func,{M,F,A}}]}; - _ -> - nodata - end. - - -%============================================================================= -% Functions for getting *.tool configuration files -%============================================================================= - -%---------------------------------------- -% tool_files(Dir) => ToolFiles -% Dir - string() Directory name -% ToolFiles - [string()] -% Return the list of all files in Dir ending with .tool (appended to Dir) -%---------------------------------------- -tool_files(Dir) -> - case file:list_dir(Dir) of - {ok,Files} -> - filter_tool_files(Dir,Files); - {error,_Reason} -> - [] - end. - -%---------------------------------------- -% filter_tool_files(Dir,Files) => ToolFiles -% Dir - string() Directory name -% Files, ToolFiles - [string()] File names -% Filters out the files in Files ending with .tool and append them to Dir -%---------------------------------------- -filter_tool_files(_Dir,[]) -> - []; -filter_tool_files(Dir,[File|Rest]) -> - case filename:extension(File) of - ".tool" -> - [filename:join(Dir,File)|filter_tool_files(Dir,Rest)]; - _ -> - filter_tool_files(Dir,Rest) - end. - - -%%%----------------------------------------------------------------- -%%% format functions -ffunc({M,F,A}) when is_list(A) -> - io_lib:format("~w:~w(~s)\n",[M,F,format_args(A)]); -ffunc({M,F,A}) when is_integer(A) -> - io_lib:format("~w:~w/~w\n",[M,F,A]). - -format_args([]) -> - ""; -format_args(Args) -> - Str = lists:append(["~p"|lists:duplicate(length(Args)-1,",~p")]), - io_lib:format(Str,Args). diff --git a/lib/webtool/src/webtool_sup.erl b/lib/webtool/src/webtool_sup.erl deleted file mode 100644 index e4a05c53ae..0000000000 --- a/lib/webtool/src/webtool_sup.erl +++ /dev/null @@ -1,75 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2009. 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(webtool_sup). - --behaviour(supervisor). - -%% External exports --export([start_link/0,stop/1]). - -%% supervisor callbacks --export([init/1]). - -%%%---------------------------------------------------------------------- -%%% API -%%%---------------------------------------------------------------------- -start_link() -> - supervisor:start_link({local,websup},webtool_sup, []). - -stop(Pid)-> - exit(Pid,normal). -%%%---------------------------------------------------------------------- -%%% Callback functions from supervisor -%%%---------------------------------------------------------------------- - -%%---------------------------------------------------------------------- -%% Func: init/1 -%% Returns: {ok, {SupFlags, [ChildSpec]}} | -%% ignore | -%% {error, Reason} -%%---------------------------------------------------------------------- -init(_StartArgs) -> - %%Child1 = - %%Child2 ={webcover_backend,{webcover_backend,start_link,[]},permanent,2000,worker,[webcover_backend]}, - %%{ok,{{simple_one_for_one,5,10},[Child1]}}. - {ok,{{one_for_one,100,10},[]}}. - -%%%---------------------------------------------------------------------- -%%% Internal functions -%%%---------------------------------------------------------------------- - - - - - - - - - - - - - - - - - - - diff --git a/lib/webtool/test/Makefile b/lib/webtool/test/Makefile deleted file mode 100644 index 93aa1c09eb..0000000000 --- a/lib/webtool/test/Makefile +++ /dev/null @@ -1,65 +0,0 @@ -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- - -MODULES= \ - webtool_SUITE - -ERL_FILES= $(MODULES:%=%.erl) - -TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) -INSTALL_PROGS= $(TARGET_FILES) - -EMAKEFILE=Emakefile - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/webtool_test - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- - -ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include - -EBIN = . - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -make_emakefile: - $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) $(MODULES) \ - > $(EMAKEFILE) - $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) '*_SUITE_make' \ - >> $(EMAKEFILE) - -tests debug opt: make_emakefile - erl $(ERL_MAKE_FLAGS) -make - -clean: - rm -f $(EMAKEFILE) - rm -f $(TARGET_FILES) $(GEN_FILES) - rm -f core - -docs: - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_spec: opt - -release_tests_spec: make_emakefile - $(INSTALL_DIR) "$(RELSYSDIR)" - $(INSTALL_DATA) $(EMAKEFILE) $(ERL_FILES) "$(RELSYSDIR)" - $(INSTALL_DATA) webtool.spec "$(RELSYSDIR)" - chmod -R u+w "$(RELSYSDIR)" - -release_docs_spec: diff --git a/lib/webtool/test/webtool.spec b/lib/webtool/test/webtool.spec deleted file mode 100644 index 134e6ed40c..0000000000 --- a/lib/webtool/test/webtool.spec +++ /dev/null @@ -1 +0,0 @@ -{suites,"../webtool_test",all}. diff --git a/lib/webtool/test/webtool_SUITE.erl b/lib/webtool/test/webtool_SUITE.erl deleted file mode 100644 index 9e2d9a2e0f..0000000000 --- a/lib/webtool/test/webtool_SUITE.erl +++ /dev/null @@ -1,51 +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 Utvecklings AB. -%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings -%% AB. All Rights Reserved.'' -%% --module(webtool_SUITE). - --compile([export_all]). --include_lib("common_test/include/ct.hrl"). - -suite() -> - [{ct_hooks, [ts_install_cth]}]. - -all() -> - [app, appup]. - -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - -app() -> - [{doc, "Test that the webtool app file is ok"}]. -app(Config) when is_list(Config) -> - ok = ?t:app_test(webtool). - -appup() -> - [{doc, "Test that the webtool appup file is ok"}]. -appup(Config) when is_list(Config) -> - ok = ?t:appup_test(webtool). diff --git a/lib/webtool/vsn.mk b/lib/webtool/vsn.mk deleted file mode 100644 index 4a701ae6e0..0000000000 --- a/lib/webtool/vsn.mk +++ /dev/null @@ -1 +0,0 @@ -WEBTOOL_VSN=0.9 diff --git a/lib/wx/examples/demo/ex_canvas.erl b/lib/wx/examples/demo/ex_canvas.erl index cdc783055c..acc94743d6 100644 --- a/lib/wx/examples/demo/ex_canvas.erl +++ b/lib/wx/examples/demo/ex_canvas.erl @@ -219,4 +219,4 @@ redraw(DC, Bitmap) -> wxMemoryDC:destroy(MemoryDC). get_pos(W,H) -> - {random:uniform(W), random:uniform(H)}. + {rand:uniform(W), rand:uniform(H)}. diff --git a/lib/wx/examples/sudoku/sudoku_game.erl b/lib/wx/examples/sudoku/sudoku_game.erl index e3c39b4ec9..8bb5fe4d38 100644 --- a/lib/wx/examples/sudoku/sudoku_game.erl +++ b/lib/wx/examples/sudoku/sudoku_game.erl @@ -151,8 +151,7 @@ test() -> %% Known to solvable {{9,2},4}, {{9,4},5}, {{9,6},8}, {{9,8},7}]. new_game(S) -> - {X,Y,Z} = erlang:now(), - random:seed(Y,X,Z), + rand:seed(exsplus), case new_game(1,1,gb_sets:empty(),empty_table(S#s{}),[], 0) of stop -> new_game(S); Game -> Game @@ -171,7 +170,7 @@ new_game(R,C,BT,St,Acc,Cnt) when R < 10, C < 10 -> [{{BR,BC},BVal,BBT,BST}|BAcc] = Acc, new_game(BR,BC,gb_sets:add(BVal,BBT),BST,BAcc,Cnt+1); Size -> - Ind = random:uniform(Size), + Ind = rand:uniform(Size), V = lists:nth(Ind,gb_sets:to_list(S)), new_game(R,C+1,gb_sets:empty(), add({R,C,M},V,St), @@ -207,7 +206,7 @@ pick_shown(Given,Left,S0,Level,Gfx) -> io:format("Below level ~p ~p~n", [GivenSz,Level]), S0; true -> - Ran = random:uniform(LeftSz), + Ran = rand:uniform(LeftSz), V = lists:nth(Ran,gb_sets:to_list(Left)), S1 = rebuild_all(rcm(V),S0#s{v=setelement(V,S0#s.v,0)}), case solve(S1, true) of diff --git a/lib/xmerl/src/xmerl_sax_parser_base.erlsrc b/lib/xmerl/src/xmerl_sax_parser_base.erlsrc index 2bbe0eea1a..2c5caab07b 100644 --- a/lib/xmerl/src/xmerl_sax_parser_base.erlsrc +++ b/lib/xmerl/src/xmerl_sax_parser_base.erlsrc @@ -152,6 +152,7 @@ parse_document(Rest, State) when is_record(State, xmerl_sax_parser_state) -> %% [22] prolog ::= XMLDecl? Misc* (doctypedecl Misc*)? %% [23] XMLDecl ::= '<?xml' VersionInfo EncodingDecl? SDDecl? S? '?>' %%---------------------------------------------------------------------- +-dialyzer({[no_fail_call, no_match], parse_xml_decl/2}). parse_xml_decl(?STRING_EMPTY, State) -> cf(?STRING_EMPTY, State, fun parse_xml_decl/2); parse_xml_decl(?BYTE_ORDER_MARK_1, State) -> @@ -1205,6 +1206,7 @@ send_character_event(_, true, String, State) -> %% Description: Parse whitespaces. %% [3] S ::= (#x20 | #x9 | #xD | #xA)+ %%---------------------------------------------------------------------- +-dialyzer({no_fail_call, whitespace/3}). whitespace(?STRING_EMPTY, State, Acc) -> case cf(?STRING_EMPTY, State, Acc, fun whitespace/3) of {?STRING_EMPTY, State} -> @@ -1716,6 +1718,7 @@ handle_external_entity({Tag, _Url}, State) -> %% Result : {Rest, State} %% Description: Parse the external entity. %%---------------------------------------------------------------------- +-dialyzer({[no_fail_call, no_match], parse_external_entity_1/2}). parse_external_entity_1(?STRING_EMPTY, #xmerl_sax_parser_state{file_type=Type} = State) -> case catch cf(?STRING_EMPTY, State, fun parse_external_entity_1/2) of {Rest, State1} when is_record(State1, xmerl_sax_parser_state) -> diff --git a/lib/xmerl/src/xmerl_scan.erl b/lib/xmerl/src/xmerl_scan.erl index 2bf3172d87..829716dcdb 100644 --- a/lib/xmerl/src/xmerl_scan.erl +++ b/lib/xmerl/src/xmerl_scan.erl @@ -1010,7 +1010,7 @@ scan_optional_version(T,S) -> scan_enc_name([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_enc_name(MoreBytes, S1) end, - fun(S1) -> ?fatal(expected_encoding_name, S1) end, + fatal_fun(expected_encoding_name), S); scan_enc_name([H|T], S0) when H >= $"; H =< $' -> ?bump_col(1), @@ -1020,7 +1020,7 @@ scan_enc_name([H|T], S0) when H >= $"; H =< $' -> scan_enc_name([], S=#xmerl_scanner{continuation_fun = F}, Delim, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_enc_name(MoreBytes, S1, Delim, Acc) end, - fun(S1) -> ?fatal(expected_encoding_name, S1) end, + fatal_fun(expected_encoding_name), S); scan_enc_name([H|T], S0, Delim, Acc) when H >= $a, H =< $z -> ?bump_col(1), @@ -1034,7 +1034,7 @@ scan_enc_name([H|_T],S,_Delim,_Acc) -> scan_enc_name2([], S=#xmerl_scanner{continuation_fun = F}, Delim, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_enc_name2(MoreBytes, S1, Delim, Acc) end, - fun(S1) -> ?fatal(expected_encoding_name, S1) end, + fatal_fun(expected_encoding_name), S); scan_enc_name2([H|T], S0, H, Acc) -> ?bump_col(1), @@ -1058,7 +1058,7 @@ scan_enc_name2([H|T], S0, Delim, Acc) when H == $.; H == $_; H == $- -> scan_xml_vsn([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_xml_vsn(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_xml_vsn([H|T], S) when H==$"; H==$'-> xml_vsn(T, S#xmerl_scanner{col = S#xmerl_scanner.col+1}, H, []). @@ -1066,7 +1066,7 @@ scan_xml_vsn([H|T], S) when H==$"; H==$'-> xml_vsn([], S=#xmerl_scanner{continuation_fun = F}, Delim, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> xml_vsn(MoreBytes, S1, Delim, Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); xml_vsn([H|T], S=#xmerl_scanner{col = C}, H, Acc) -> {lists:reverse(Acc), T, S#xmerl_scanner{col = C+1}}; @@ -1089,7 +1089,7 @@ xml_vsn([H|T], S=#xmerl_scanner{col = C}, Delim, Acc) -> scan_pi([], S=#xmerl_scanner{continuation_fun = F}, Pos, Ps) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_pi(MoreBytes, S1, Pos, Ps) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_pi(Str = [H1,H2,H3 | T],S0=#xmerl_scanner{line = L, col = C}, Pos, Ps) when H1==$x;H1==$X -> @@ -1125,7 +1125,7 @@ scan_pi([], S=#xmerl_scanner{continuation_fun = F}, Target, ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_pi(MoreBytes, S1, Target, L, C, Pos, Ps, Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_pi("?>" ++ T, S0 = #xmerl_scanner{hook_fun = Hook, event_fun = Event}, @@ -1152,7 +1152,7 @@ scan_pi2([], S=#xmerl_scanner{continuation_fun = F}, Target, ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_pi2(MoreBytes, S1, Target, L, C, Pos, Ps, Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_pi2("?>" ++ T, S0 = #xmerl_scanner{hook_fun = Hook, event_fun = Event}, @@ -1180,7 +1180,7 @@ scan_pi2(Str, S0, Target, L, C, Pos, Ps, Acc) -> scan_doctype([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_doctype(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_doctype(T, S) -> {_,T1,S1} = mandatory_strip(T,S), @@ -1194,7 +1194,7 @@ scan_doctype(T, S) -> scan_doctype1([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_doctype1(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_doctype1("PUBLIC" ++ T, S0) -> ?bump_col(6), @@ -1217,7 +1217,7 @@ scan_doctype1(T, S) -> scan_doctype2([], S=#xmerl_scanner{continuation_fun = F},DTD) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_doctype2(MoreBytes, S1, DTD) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_doctype2("[" ++ T, S0, DTD) -> ?bump_col(1), @@ -1237,7 +1237,7 @@ scan_doctype2(_T,S,_DTD) -> scan_doctype3([], S=#xmerl_scanner{continuation_fun = F},DTD) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_doctype3(MoreBytes, S1,DTD) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_doctype3("%" ++ T, S0, DTD) -> ?bump_col(1), @@ -1549,7 +1549,7 @@ scan_decl_sep(T,S) -> scan_conditional_sect([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_conditional_sect(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_conditional_sect("IGNORE" ++ T, S0) -> ?bump_col(6), @@ -1582,7 +1582,7 @@ scan_ignore(Str,S) -> scan_ignore([], S=#xmerl_scanner{continuation_fun = F},Level) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_ignore(MoreBytes, S1,Level) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_ignore("<![" ++ T, S0,Level) -> %% nested conditional section. Topmost condition is ignore, though @@ -1603,7 +1603,7 @@ scan_ignore([_H|T],S0,Level) -> scan_include([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_include(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_include("]]>" ++ T, S0) -> ?bump_col(3), @@ -1745,7 +1745,7 @@ update_attributes1([],Acc) -> scan_attdef([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_attdef(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_attdef(T, S) -> scan_attdef(T, S, _AttrAcc = []). @@ -1754,7 +1754,7 @@ scan_attdef(T, S) -> scan_attdef([], S=#xmerl_scanner{continuation_fun = F}, Attrs) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_attdef(MoreBytes, S1, Attrs) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_attdef(">" ++ T, S0, Attrs) -> ?bump_col(1), @@ -1798,7 +1798,7 @@ scan_attdef2(T, S, Attrs) -> scan_att_type([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_att_type(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_att_type("CDATA" ++ T, S0) -> ?bump_col(5), @@ -1856,7 +1856,7 @@ scan_att_type("%" ++ T, S0) -> scan_notation_type([], S=#xmerl_scanner{continuation_fun = F}, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_notation_type(MoreBytes, S1, Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_notation_type(")" ++ T, S0, Acc) -> ?bump_col(1), @@ -1889,7 +1889,7 @@ notation_exists(Name, #xmerl_scanner{rules_read_fun = Read, scan_enumeration([], S=#xmerl_scanner{continuation_fun = F}, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_enumeration(MoreBytes, S1, Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_enumeration(")" ++ T, S0, Acc) -> ?bump_col(1), @@ -1907,7 +1907,7 @@ scan_enumeration("|" ++ T, S0, Acc) -> scan_default_decl([], S=#xmerl_scanner{continuation_fun = F}, Type) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_default_decl(MoreBytes, S1, Type) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_default_decl("#REQUIRED" ++ T, S0, _Type) -> ?bump_col(9), @@ -1936,7 +1936,7 @@ default_value(T, S, Type) -> scan_entity([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_entity(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_entity("%" ++ T, #xmerl_scanner{rules_write_fun = Write} = S0) -> %% parameter entity @@ -1974,7 +1974,7 @@ scan_entity_completion(T,S) -> scan_entity_def([], S=#xmerl_scanner{continuation_fun = F}, EName) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_entity_def(MoreBytes, S1, EName) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_entity_def("'" ++ T, S0, EName) -> ?bump_col(1), @@ -2015,7 +2015,7 @@ scan_entity_def(Str, S, EName) -> scan_ndata_decl([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_ndata_decl(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_ndata_decl(Str = ">"++_T, S) -> {[], Str, S}; @@ -2062,7 +2062,7 @@ scan_element("/", S=#xmerl_scanner{continuation_fun = F}, F(fun(MoreBytes, S1) -> scan_element("/" ++ MoreBytes, S1, Pos, Name, StartL, StartC, Attrs, Lang,Parents,NSI,NS,SpaceDefault) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_element([], S=#xmerl_scanner{continuation_fun = F}, Pos, Name, StartL, StartC, Attrs, Lang, Parents, @@ -2071,7 +2071,7 @@ scan_element([], S=#xmerl_scanner{continuation_fun = F}, F(fun(MoreBytes, S1) -> scan_element(MoreBytes, S1, Pos, Name, StartL, StartC, Attrs, Lang,Parents,NSI,NS,SpaceDefault) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_element("/>" ++ T, S0 = #xmerl_scanner{hook_fun = Hook, event_fun = Event, @@ -2099,7 +2099,7 @@ scan_element(">", S=#xmerl_scanner{continuation_fun = F}, F(fun(MoreBytes, S1) -> scan_element(">" ++ MoreBytes, S1, Pos, Name, StartL, StartC, Attrs, Lang,Parents,NSI,NS,SpaceDefault) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_element(">" ++ T, S0 = #xmerl_scanner{event_fun = Event, hook_fun = Hook, @@ -2344,7 +2344,7 @@ keyreplaceadd(_K, _Pos, [], Obj) -> scan_att_value([], S=#xmerl_scanner{continuation_fun = F},AT) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_att_value(MoreBytes, S1, AT) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_att_value("%"++_T,S=#xmerl_scanner{environment=prolog},_AttType) -> ?fatal({error,{wfc_PEs_In_Internal_Subset}},S); @@ -2385,7 +2385,7 @@ scan_att_chars([],S=#xmerl_scanner{continuation_fun=F},H,Acc,TmpAcc,AT,IsNorm)-> F(fun(MoreBytes, S1) -> scan_att_chars(MoreBytes, S1, H, Acc,TmpAcc,AT,IsNorm) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_att_chars([H|T], S0, H, Acc, TmpAcc,AttType,IsNorm) -> % End quote ?bump_col(1), @@ -2518,7 +2518,7 @@ scan_content("<", S= #xmerl_scanner{continuation_fun = F}, F(fun(MoreBytes, S1) -> scan_content("<" ++ MoreBytes, S1, Pos, Name, Attrs, Space, Lang, Parents, NS, Acc,[]) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_content([], S=#xmerl_scanner{environment={external,{entity,_}}}, _Pos, _Name, _Attrs, _Space, _Lang, _Parents, _NS, Acc,_) -> @@ -2532,7 +2532,7 @@ scan_content([], S=#xmerl_scanner{continuation_fun = F}, F(fun(MoreBytes, S1) -> scan_content(MoreBytes, S1, Pos, Name, Attrs, Space, Lang, Parents, NS, Acc,[]) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_content("</" ++ T, S0, _Pos, Name, _Attrs, _Space, _Lang, _Parents, _NS, Acc,[]) -> @@ -2636,7 +2636,7 @@ scan_content_markup([], S=#xmerl_scanner{continuation_fun = F}, F(fun(MoreBytes, S1) -> scan_content_markup( MoreBytes,S1,Pos,Name, Attrs,Space,Lang,Parents,NS) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_content_markup("![CDATA[" ++ T, S0, Pos, _Name, _Attrs, _Space, _Lang, Parents, _NS) -> @@ -2664,7 +2664,7 @@ scan_char_data([], S=#xmerl_scanner{environment=internal_parsed_entity}, scan_char_data([], S=#xmerl_scanner{continuation_fun = F}, Space, _MUD,Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_char_data(MoreBytes,S1,Space,_MUD,Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_char_data([$&|T], S,Space,"&",Acc) -> scan_char_data(T, S, Space,[], [$&|Acc]); @@ -2716,7 +2716,7 @@ scan_cdata(Str, S, Pos, Parents) -> scan_cdata([], S=#xmerl_scanner{continuation_fun = F}, Pos, Parents, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_cdata(MoreBytes, S1, Pos, Parents, Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_cdata("]]>" ++ T, S0, Pos, Parents, Acc) -> ?bump_col(3), @@ -2741,7 +2741,7 @@ scan_cdata(Str, S0, Pos, Parents, Acc) -> scan_reference([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_reference(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_reference("#x" ++ T, S0) -> %% [66] CharRef @@ -2783,7 +2783,7 @@ scan_reference(T, S) -> scan_entity_ref([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_entity_ref(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_entity_ref("amp;" ++ T, S0) -> ?bump_col(4), @@ -2868,7 +2868,7 @@ expand_reference(Name, #xmerl_scanner{rules_read_fun = Read} = S) -> scan_char_ref_dec([], S=#xmerl_scanner{continuation_fun = F}, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_char_ref_dec(MoreBytes, S1, Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_char_ref_dec([H|T], S0, Acc) when H >= $0, H =< $9 -> ?bump_col(1), @@ -2883,7 +2883,7 @@ scan_char_ref_dec(";" ++ T, S0, Acc) -> scan_char_ref_hex([], S=#xmerl_scanner{continuation_fun = F}, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_char_ref_hex(MoreBytes, S1, Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_char_ref_hex([H|T], S0, Acc) when H >= $0, H =< $9 -> ?bump_col(1), @@ -2957,7 +2957,7 @@ scan_name_no_colons(Str, S) -> scan_name([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_name(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_name(Str = [$:|T], S0 = #xmerl_scanner{namespace_conformant = NSC}) -> if NSC == false -> @@ -3007,7 +3007,7 @@ scan_nmtoken(Str, S, Acc, NSC) -> scan_nmtoken([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_nmtoken(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_nmtoken("%"++T, S0=#xmerl_scanner{environment={external,_}}) -> ?bump_col(1), @@ -3084,7 +3084,7 @@ isLatin1(_,_) -> scan_system_literal([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_system_literal(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_system_literal("\"" ++ T, S) -> scan_system_literal(T, S, $", []); @@ -3096,7 +3096,7 @@ scan_system_literal([], S=#xmerl_scanner{continuation_fun = F}, Delimiter, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_system_literal(MoreBytes,S1,Delimiter,Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_system_literal([H|T], S, H, Acc) -> {lists:reverse(Acc), T, S#xmerl_scanner{col = S#xmerl_scanner.col+1}}; @@ -3114,7 +3114,7 @@ scan_system_literal(Str, S, Delimiter, Acc) -> scan_pubid_literal([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_pubid_literal(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_pubid_literal([H|T], S) when H == $"; H == $' -> scan_pubid_literal(T, S#xmerl_scanner{col = S#xmerl_scanner.col+1}, H, []); @@ -3126,7 +3126,7 @@ scan_pubid_literal([], S=#xmerl_scanner{continuation_fun = F}, Delimiter, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_pubid_literal(MoreBytes,S1,Delimiter,Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_pubid_literal([H|T], S, H, Acc) -> {lists:reverse(Acc), T, S#xmerl_scanner{col = S#xmerl_scanner.col+1}}; @@ -3161,7 +3161,7 @@ is_pubid_char(X) -> scan_contentspec([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_contentspec(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_contentspec("EMPTY" ++ T, S0) -> ?bump_col(5), @@ -3195,7 +3195,7 @@ scan_elem_content([], S=#xmerl_scanner{continuation_fun = F}, Context, Mode, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes,S1) -> scan_elem_content(MoreBytes,S1,Context,Mode,Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_elem_content(")" ++ T, S0, Context, Mode0, Acc0) -> ?bump_col(1), @@ -3282,7 +3282,7 @@ format_elem_content(Other) -> Other. scan_occurrence([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_occurrence(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_occurrence([$?|T], S0) -> ?bump_col(1), @@ -3433,7 +3433,7 @@ wfc_whitespace_betw_attrs([$> |_]=L,S) -> wfc_whitespace_betw_attrs([],S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> wfc_whitespace_betw_attrs(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); wfc_whitespace_betw_attrs(_,S) -> ?fatal({whitespace_required_between_attributes},S). @@ -3477,7 +3477,7 @@ vc_Element_valid(_,_) -> scan_pe_def([], S=#xmerl_scanner{continuation_fun = F}, PEName) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_pe_def(MoreBytes, S1, PEName) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_pe_def("'" ++ T, S0, PEName) -> ?bump_col(1), @@ -3510,7 +3510,7 @@ scan_notation_decl(T, #xmerl_scanner{rules_write_fun = Write, scan_notation_decl1([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_notation_decl1(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_notation_decl1("SYSTEM" ++ T, S0) -> ?bump_col(6), @@ -3536,7 +3536,7 @@ scan_notation_decl1("PUBLIC" ++ T, S0) -> scan_external_id([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_external_id(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_external_id("SYSTEM" ++ T, S0) -> ?bump_col(6), @@ -3582,7 +3582,7 @@ scan_entity_value([], S=#xmerl_scanner{continuation_fun = F}, scan_entity_value(MoreBytes,S1, Delim,Acc,PEName,Namespace,PENesting) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_entity_value([Delim|T], S=#xmerl_scanner{validation=dtd}, Delim,_Acc,PEName,_NS,PENesting) when length(PENesting) /= 0 -> @@ -3850,7 +3850,7 @@ scan_comment1([], S=#xmerl_scanner{continuation_fun = F}, Pos, Comment, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_comment1(MoreBytes, S1, Pos, Comment, Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_comment1("-->" ++ T, S0 = #xmerl_scanner{col = C, event_fun = Event, @@ -4100,6 +4100,13 @@ handle_schema_result({error,Reason},S5) -> %%% Helper functions +-compile({inline, [fatal_fun/1]}). + +-spec fatal_fun(_) -> fun((_) -> no_return()). + +fatal_fun(Reason) -> + fun(S) -> ?fatal(Reason, S) end. + fatal(Reason, S) -> exit({fatal, {Reason, {file,S#xmerl_scanner.filename}, diff --git a/lib/xmerl/test/Makefile b/lib/xmerl/test/Makefile index f9c03336c8..14e11d5fc4 100644 --- a/lib/xmerl/test/Makefile +++ b/lib/xmerl/test/Makefile @@ -84,7 +84,7 @@ RELSYSDIR = $(RELEASE_PATH)/xmerl_test # FLAGS # ---------------------------------------------------- -#ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include -I$(ERL_TOP)/lib/xmerl/include/ $(XMERL_PRESERV_TEST_DIRS) +ERL_COMPILE_FLAGS += # ---------------------------------------------------- diff --git a/lib/xmerl/test/xmerl_SUITE.erl b/lib/xmerl/test/xmerl_SUITE.erl index 7ddf1066de..672f8a43d1 100644 --- a/lib/xmerl/test/xmerl_SUITE.erl +++ b/lib/xmerl/test/xmerl_SUITE.erl @@ -27,7 +27,7 @@ %%---------------------------------------------------------------------- %% Include files %%---------------------------------------------------------------------- --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %%-include("xmerl.hrl"). -include_lib("xmerl/include/xmerl.hrl"). -include_lib("kernel/include/file.hrl"). diff --git a/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_abbrev.erl b/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_abbrev.erl index afd39b6598..2e026d7476 100644 --- a/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_abbrev.erl +++ b/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_abbrev.erl @@ -10,7 +10,7 @@ -export([test/0, check_node_set/2, ticket_6873/0, ticket_7496/0, functions/0]). -export([namespaces/0]). --include("test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("xmerl/include/xmerl.hrl"). test() -> diff --git a/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_lib.erl b/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_lib.erl index 4cde46826e..f5c65b0c63 100644 --- a/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_lib.erl +++ b/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_lib.erl @@ -9,7 +9,7 @@ -export([test/0,check_node_set/2,ticket_6873/0]). --include("test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("xmerl/include/xmerl.hrl"). test() -> diff --git a/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_text.erl b/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_text.erl index e39ad6bcb0..c3a1fb9c4d 100644 --- a/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_text.erl +++ b/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_text.erl @@ -9,7 +9,7 @@ -compile(export_all). --include("test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("xmerl/include/xmerl.hrl"). -import(xmerl_xs, diff --git a/lib/xmerl/test/xmerl_sax_SUITE.erl b/lib/xmerl/test/xmerl_sax_SUITE.erl index a15d9bd57c..f0e80f81d3 100644 --- a/lib/xmerl/test/xmerl_sax_SUITE.erl +++ b/lib/xmerl/test/xmerl_sax_SUITE.erl @@ -27,7 +27,7 @@ %%---------------------------------------------------------------------- %% Include files %%---------------------------------------------------------------------- --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). %%====================================================================== diff --git a/lib/xmerl/test/xmerl_sax_std_SUITE.erl b/lib/xmerl/test/xmerl_sax_std_SUITE.erl index 70e768ff04..b820bd5bc2 100644 --- a/lib/xmerl/test/xmerl_sax_std_SUITE.erl +++ b/lib/xmerl/test/xmerl_sax_std_SUITE.erl @@ -27,7 +27,7 @@ %%---------------------------------------------------------------------- %% Include files %%---------------------------------------------------------------------- --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). %%====================================================================== diff --git a/lib/xmerl/test/xmerl_std_SUITE.erl b/lib/xmerl/test/xmerl_std_SUITE.erl index 0ef44bb04e..d3e28353e2 100644 --- a/lib/xmerl/test/xmerl_std_SUITE.erl +++ b/lib/xmerl/test/xmerl_std_SUITE.erl @@ -25,7 +25,7 @@ %%---------------------------------------------------------------------- %% Include files %%---------------------------------------------------------------------- --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %%-include("xmerl.hrl"). -include_lib("xmerl/include/xmerl.hrl"). diff --git a/lib/xmerl/test/xmerl_test_lib.erl b/lib/xmerl/test/xmerl_test_lib.erl index 62689353f2..aa8a86138a 100644 --- a/lib/xmerl/test/xmerl_test_lib.erl +++ b/lib/xmerl/test/xmerl_test_lib.erl @@ -28,7 +28,7 @@ -compile(export_all). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("xmerl/include/xmerl.hrl"). %% cmp_element/2 diff --git a/lib/xmerl/test/xmerl_xsd_MS2002-01-16_SUITE.erl b/lib/xmerl/test/xmerl_xsd_MS2002-01-16_SUITE.erl index ee648dc455..7393a878e2 100644 --- a/lib/xmerl/test/xmerl_xsd_MS2002-01-16_SUITE.erl +++ b/lib/xmerl/test/xmerl_xsd_MS2002-01-16_SUITE.erl @@ -27,7 +27,7 @@ -compile(export_all). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("xmerl/include/xmerl.hrl"). -include_lib("xmerl/include/xmerl_xsd.hrl"). diff --git a/lib/xmerl/test/xmerl_xsd_NIST2002-01-16_SUITE.erl b/lib/xmerl/test/xmerl_xsd_NIST2002-01-16_SUITE.erl index 634e47ba7b..6a645b255e 100644 --- a/lib/xmerl/test/xmerl_xsd_NIST2002-01-16_SUITE.erl +++ b/lib/xmerl/test/xmerl_xsd_NIST2002-01-16_SUITE.erl @@ -27,7 +27,7 @@ -compile(export_all). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("xmerl/include/xmerl.hrl"). -include_lib("xmerl/include/xmerl_xsd.hrl"). diff --git a/lib/xmerl/test/xmerl_xsd_SUITE.erl b/lib/xmerl/test/xmerl_xsd_SUITE.erl index 92c8287782..e1ce8525c7 100644 --- a/lib/xmerl/test/xmerl_xsd_SUITE.erl +++ b/lib/xmerl/test/xmerl_xsd_SUITE.erl @@ -25,7 +25,7 @@ -compile(export_all). %%-export([Function/Arity, ...]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %%-include("xmerl.hrl"). -include_lib("xmerl/include/xmerl.hrl"). diff --git a/lib/xmerl/test/xmerl_xsd_Sun2002-01-16_SUITE.erl b/lib/xmerl/test/xmerl_xsd_Sun2002-01-16_SUITE.erl index 5ad6bb94fb..5057e70956 100644 --- a/lib/xmerl/test/xmerl_xsd_Sun2002-01-16_SUITE.erl +++ b/lib/xmerl/test/xmerl_xsd_Sun2002-01-16_SUITE.erl @@ -27,7 +27,7 @@ -compile(export_all). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("xmerl/include/xmerl.hrl"). -include_lib("xmerl/include/xmerl_xsd.hrl"). diff --git a/lib/xmerl/test/xmerl_xsd_lib.erl b/lib/xmerl/test/xmerl_xsd_lib.erl index 892706609f..58fb6a27cc 100644 --- a/lib/xmerl/test/xmerl_xsd_lib.erl +++ b/lib/xmerl/test/xmerl_xsd_lib.erl @@ -32,7 +32,7 @@ -compile(export_all). --include("test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("xmerl.hrl"). -include("xmerl_xsd.hrl"). -include_lib("kernel/include/file.hrl"). |
