aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/common_test/doc/src/Makefile3
-rw-r--r--lib/common_test/doc/src/ct_testspec.xml84
-rw-r--r--lib/common_test/doc/src/ref_man.xml1
-rw-r--r--lib/common_test/src/ct_testspec.erl28
-rw-r--r--lib/common_test/test/ct_testspec_2_SUITE.erl82
-rw-r--r--lib/dialyzer/test/options1_SUITE_data/results/compiler2
-rw-r--r--lib/dialyzer/test/r9c_SUITE_data/results/mnesia1
-rw-r--r--lib/erl_interface/doc/src/erl_call.xml2
-rw-r--r--lib/kernel/src/os.erl24
-rw-r--r--lib/kernel/test/code_SUITE.erl36
-rw-r--r--lib/ssh/src/ssh_cli.erl18
-rw-r--r--lib/ssh/src/ssh_sftpd.erl55
-rw-r--r--lib/ssh/test/ssh_sftpd_SUITE.erl161
-rw-r--r--lib/ssh/test/ssh_to_openssh_SUITE.erl2
-rw-r--r--lib/ssl/doc/src/ssl_session_cache_api.xml29
-rw-r--r--lib/ssl/src/tls_v1.erl18
-rw-r--r--lib/stdlib/doc/src/filename.xml27
-rw-r--r--lib/stdlib/src/c.erl6
-rw-r--r--lib/stdlib/src/filename.erl37
-rw-r--r--lib/stdlib/src/io_lib_pretty.erl131
-rw-r--r--lib/stdlib/src/sofs.erl357
-rw-r--r--lib/stdlib/test/filename_SUITE.erl69
-rw-r--r--lib/stdlib/test/io_SUITE.erl241
-rw-r--r--lib/stdlib/test/sofs_SUITE.erl9
-rw-r--r--lib/xmerl/src/xmerl_sax_parser.erl33
-rw-r--r--lib/xmerl/src/xmerl_sax_parser.hrl9
-rw-r--r--lib/xmerl/src/xmerl_sax_parser_base.erlsrc84
-rw-r--r--lib/xmerl/test/Makefile4
-rw-r--r--lib/xmerl/test/xmerl_sax_SUITE.erl6
-rw-r--r--lib/xmerl/test/xmerl_sax_std_SUITE.erl100
-rw-r--r--lib/xmerl/test/xmerl_sax_stream_SUITE.erl245
-rw-r--r--lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_one.xml17
-rw-r--r--lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_one_junk.xml18
-rw-r--r--lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_two.xml34
34 files changed, 1525 insertions, 448 deletions
diff --git a/lib/common_test/doc/src/Makefile b/lib/common_test/doc/src/Makefile
index e495f587a3..152ece5d25 100644
--- a/lib/common_test/doc/src/Makefile
+++ b/lib/common_test/doc/src/Makefile
@@ -53,7 +53,8 @@ XML_REF3_FILES = ct.xml \
ct_slave.xml \
ct_property_test.xml \
ct_netconfc.xml \
- ct_hooks.xml
+ ct_hooks.xml \
+ ct_testspec.xml
XML_REF6_FILES = common_test_app.xml
XML_PART_FILES = part.xml
diff --git a/lib/common_test/doc/src/ct_testspec.xml b/lib/common_test/doc/src/ct_testspec.xml
new file mode 100644
index 0000000000..36893f66cf
--- /dev/null
+++ b/lib/common_test/doc/src/ct_testspec.xml
@@ -0,0 +1,84 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>2016</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ Licensed under the Apache License, Version 2.0 (the "License");
+ you may not use this file except in compliance with the License.
+ You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+
+ </legalnotice>
+
+ <title>ct_testspec</title>
+ <prepared></prepared>
+ <responsible></responsible>
+ <docno></docno>
+ <approved></approved>
+ <checked></checked>
+ <date></date>
+ <rev>A</rev>
+ <file>ct_testspec.xml</file>
+ </header>
+ <module>ct_testspec</module>
+ <modulesummary>Parsing of test specifications for Common Test.
+ </modulesummary>
+
+<description>
+
+ <p>Parsing of test specifications for <c>Common Test</c>.</p>
+
+ <p>This module exports help functions for parsing of test specifications.</p>
+
+</description>
+
+ <funcs>
+ <func>
+ <name>get_tests(SpecsIn) -&gt; {ok, [{Specs,Tests}]} | {error, Reason}</name>
+ <fsummary>Parse the given test specification files and return the tests to run and skip.</fsummary>
+ <type>
+ <v>SpecsIn = [string()] | [[string()]]</v>
+ <v>Specs = [string()]</v>
+ <v>Test = [{Node,Run,Skip}]</v>
+ <v>Node = atom()</v>
+ <v>Run = {Dir,Suites,Cases}</v>
+ <v>Skip = {Dir,Suites,Comment} | {Dir,Suites,Cases,Comment}</v>
+ <v>Dir = string()</v>
+ <v>Suites = atom | [atom()] | all</v>
+ <v>Cases = atom | [atom()] | all</v>
+ <v>Comment = string()</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc><marker id="add_nodes-1"/>
+ <p>Parse the given test specification files and return the
+ tests to run and skip.</p>
+
+ <p>If <c>SpecsIn=[Spec1,Spec2,...]</c>, separate tests will be
+ created per specification. If
+ <c>SpecsIn=[[Spec1,Spec2,...]]</c>, all specifications will be
+ merge into one test.</p>
+
+ <p>For each test, a <c>{Specs,Tests}</c> element is returned,
+ where <c>Specs</c> is a list of all included test
+ specifications, and <c>Tests</c> specifies actual tests to
+ run/skip per node.</p>
+ </desc>
+ </func>
+
+ </funcs>
+
+</erlref>
+
+
diff --git a/lib/common_test/doc/src/ref_man.xml b/lib/common_test/doc/src/ref_man.xml
index d1567e2d3c..1ac20db5c2 100644
--- a/lib/common_test/doc/src/ref_man.xml
+++ b/lib/common_test/doc/src/ref_man.xml
@@ -47,6 +47,7 @@
<xi:include href="ct_slave.xml"/>
<xi:include href="ct_hooks.xml"/>
<xi:include href="ct_property_test.xml"/>
+ <xi:include href="ct_testspec.xml"/>
</application>
diff --git a/lib/common_test/src/ct_testspec.erl b/lib/common_test/src/ct_testspec.erl
index 991abb0666..16001ce4c8 100644
--- a/lib/common_test/src/ct_testspec.erl
+++ b/lib/common_test/src/ct_testspec.erl
@@ -26,7 +26,8 @@
-export([prepare_tests/1, prepare_tests/2,
collect_tests_from_list/2, collect_tests_from_list/3,
- collect_tests_from_file/2, collect_tests_from_file/3]).
+ collect_tests_from_file/2, collect_tests_from_file/3,
+ get_tests/1]).
-export([testspec_rec2list/1, testspec_rec2list/2]).
@@ -803,6 +804,31 @@ list_nodes(#testspec{nodes=NodeRefs}) ->
lists:map(fun({_Ref,Node}) -> Node end, NodeRefs).
+%%%-----------------------------------------------------------------
+%%% Parse the given test specs and return the complete set of specs
+%%% and tests to run/skip.
+%%% [Spec1,Spec2,...] means create separate tests per spec
+%%% [[Spec1,Spec2,...]] means merge all specs into one
+-spec get_tests(Specs) -> {ok,[{Specs,Tests}]} | {error,Reason} when
+ Specs :: [string()] | [[string()]],
+ Tests :: {Node,Run,Skip},
+ Node :: atom(),
+ Run :: {Dir,Suites,Cases},
+ Skip :: {Dir,Suites,Comment} | {Dir,Suites,Cases,Comment},
+ Dir :: string(),
+ Suites :: atom | [atom()] | all,
+ Cases :: atom | [atom()] | all,
+ Comment :: string(),
+ Reason :: term().
+
+get_tests(Specs) ->
+ case collect_tests_from_file(Specs,true) of
+ Tests when is_list(Tests) ->
+ {ok,[{S,prepare_tests(R)} || {S,R} <- Tests]};
+ Error ->
+ Error
+ end.
+
%% -----------------------------------------------------
%% / \
%% | When adding test/config terms, remember to update |
diff --git a/lib/common_test/test/ct_testspec_2_SUITE.erl b/lib/common_test/test/ct_testspec_2_SUITE.erl
index 1a941df185..1bab80942a 100644
--- a/lib/common_test/test/ct_testspec_2_SUITE.erl
+++ b/lib/common_test/test/ct_testspec_2_SUITE.erl
@@ -220,7 +220,24 @@ basic_compatible_no_nodes(_Config) ->
{tc2,{skip,"skipped"}}]}]}],
merge_tests = true},
- verify_result(Verify,ListResult,FileResult).
+ verify_result(Verify,ListResult,FileResult),
+
+ {ok,Tests} = ct_testspec:get_tests([SpecFile]),
+ ct:pal("ct_testspec:get_tests/1:~n~p~n", [Tests]),
+ [{[SpecFile],[{Node,Run,Skip}]}] = Tests,
+ [{Alias1V,x_SUITE,all},
+ {Alias1V,y_SUITE,[{g1,all},{g2,all},tc1,tc2]},
+ {Alias1V,z_SUITE,all},
+ {Alias2V,x_SUITE,all},
+ {Alias2V,y_SUITE,all}] = lists:sort(Run),
+ [{Alias1V,z_SUITE,"skipped"},
+ {Alias2V,x_SUITE,{g1,all},"skipped"},
+ {Alias2V,x_SUITE,{g2,all},"skipped"},
+ {Alias2V,y_SUITE,tc1,"skipped"},
+ {Alias2V,y_SUITE,tc2,"skipped"}] = lists:sort(Skip),
+
+ ok.
+
%%%-----------------------------------------------------------------
%%%
@@ -346,7 +363,25 @@ basic_compatible_nodes(_Config) ->
{tc2,{skip,"skipped"}}]}]}],
merge_tests = true},
- verify_result(Verify,ListResult,FileResult).
+ verify_result(Verify,ListResult,FileResult),
+
+ {ok,Tests} = ct_testspec:get_tests([SpecFile]),
+ ct:pal("ct_testspec:get_tests/1:~n~p~n", [Tests]),
+ [{[SpecFile],[{Node,[],[]},
+ {Node1,Run1,Skip1},
+ {Node2,Run2,Skip2}]}] = Tests,
+ [{TO1V,x_SUITE,all},
+ {TO1V,y_SUITE,[{g1,all},{g2,all},tc1,tc2]},
+ {TO1V,z_SUITE,all}] = lists:sort(Run1),
+ [{TO2V,x_SUITE,all},
+ {TO2V,y_SUITE,all}] = lists:sort(Run2),
+ [{TO1V,z_SUITE,"skipped"}] = lists:sort(Skip1),
+ [{TO2V,x_SUITE,{g1,all},"skipped"},
+ {TO2V,x_SUITE,{g2,all},"skipped"},
+ {TO2V,y_SUITE,tc1,"skipped"},
+ {TO2V,y_SUITE,tc2,"skipped"}] = lists:sort(Skip2),
+
+ ok.
%%%-----------------------------------------------------------------
%%%
@@ -439,7 +474,28 @@ no_merging(_Config) ->
[{y_SUITE,[{tc1,{skip,"skipped"}},
{tc2,{skip,"skipped"}}]}]}]},
- verify_result(Verify,ListResult,FileResult).
+ verify_result(Verify,ListResult,FileResult),
+
+ {ok,Tests} = ct_testspec:get_tests([SpecFile]),
+ ct:pal("ct_testspec:get_tests/1:~n~p~n", [Tests]),
+ [{[SpecFile],[{Node,[],[]},
+ {Node1,Run1,Skip1},
+ {Node2,Run2,Skip2}]}] = Tests,
+ [{TO1V,x_SUITE,all},
+ {TO1V,y_SUITE,[tc1,tc2]},
+ {TO1V,y_SUITE,[{g1,all},{g2,all}]},
+ {TO1V,z_SUITE,all}] = lists:sort(Run1),
+ [{TO2V,x_SUITE,all},
+ {TO2V,x_SUITE,[{skipped,g1,all},{skipped,g2,all}]},
+ {TO2V,y_SUITE,all},
+ {TO2V,y_SUITE,[{skipped,tc1},{skipped,tc2}]}] = lists:sort(Run2),
+ [{TO1V,z_SUITE,"skipped"}] = lists:sort(Skip1),
+ [{TO2V,x_SUITE,{g1,all},"skipped"},
+ {TO2V,x_SUITE,{g2,all},"skipped"},
+ {TO2V,y_SUITE,tc1,"skipped"},
+ {TO2V,y_SUITE,tc2,"skipped"}] = lists:sort(Skip2),
+
+ ok.
%%%-----------------------------------------------------------------
%%%
@@ -510,7 +566,25 @@ multiple_specs(_Config) ->
{y_SUITE,[all,{tc1,{skip,"skipped"}},
{tc2,{skip,"skipped"}}]}]}]},
- verify_result(Verify,FileResult,FileResult).
+ verify_result(Verify,FileResult,FileResult),
+
+ {ok,Tests} = ct_testspec:get_tests([[SpecFile1,SpecFile2]]),
+ ct:pal("ct_testspec:get_tests/1:~n~p~n", [Tests]),
+ [{[SpecFile1,SpecFile2],[{Node,[],[]},
+ {Node1,Run1,Skip1},
+ {Node2,Run2,Skip2}]}] = Tests,
+ [{TO1V,x_SUITE,all},
+ {TO1V,y_SUITE,[{g1,all},{g2,all},tc1,tc2]},
+ {TO1V,z_SUITE,all}] = lists:sort(Run1),
+ [{TO2V,x_SUITE,all},
+ {TO2V,y_SUITE,all}] = lists:sort(Run2),
+ [{TO1V,z_SUITE,"skipped"}] = lists:sort(Skip1),
+ [{TO2V,x_SUITE,{g1,all},"skipped"},
+ {TO2V,x_SUITE,{g2,all},"skipped"},
+ {TO2V,y_SUITE,tc1,"skipped"},
+ {TO2V,y_SUITE,tc2,"skipped"}] = lists:sort(Skip2),
+
+ ok.
%%%-----------------------------------------------------------------
%%%
diff --git a/lib/dialyzer/test/options1_SUITE_data/results/compiler b/lib/dialyzer/test/options1_SUITE_data/results/compiler
index 30b6f4814a..cbb5115c91 100644
--- a/lib/dialyzer/test/options1_SUITE_data/results/compiler
+++ b/lib/dialyzer/test/options1_SUITE_data/results/compiler
@@ -31,6 +31,8 @@ cerl_inline.erl:2756: The pattern <{F, _L, D}, Vs> can never match the type <[1.
compile.erl:788: The pattern {'error', Es} can never match the type {'ok',<<_:64,_:_*8>>}
core_lint.erl:473: The pattern <{'c_atom', _, 'all'}, 'binary', _Def, St> can never match the type <_,#c_nil{} | {'c_atom' | 'c_char' | 'c_float' | 'c_int' | 'c_string' | 'c_tuple',_,_} | #c_cons{hd::#c_nil{} | {'c_atom' | 'c_char' | 'c_float' | 'c_int' | 'c_string' | 'c_tuple',_,_} | #c_cons{hd::{_,_} | {_,_,_} | {_,_,_,_},tl::{_,_} | {_,_,_} | {_,_,_,_}},tl::#c_nil{} | {'c_atom' | 'c_char' | 'c_float' | 'c_int' | 'c_string' | 'c_tuple',_,_} | #c_cons{hd::{_,_} | {_,_,_} | {_,_,_,_},tl::{_,_} | {_,_,_} | {_,_,_,_}}},[any()],_>
core_lint.erl:505: The pattern <_Req, 'unknown', St> can never match the type <non_neg_integer(),non_neg_integer(),_>
+sys_pre_expand.erl:625: Call to missing or unexported function erlang:hash/2
v3_codegen.erl:1569: The call v3_codegen:load_reg_1(V::any(),I::0,Rs::any(),pos_integer()) will never return since it differs in the 4th argument from the success typing arguments: (any(),0,maybe_improper_list(),0)
v3_codegen.erl:1571: The call v3_codegen:load_reg_1(V::any(),I::0,[],pos_integer()) will never return since it differs in the 4th argument from the success typing arguments: (any(),0,maybe_improper_list(),0)
v3_core.erl:646: Matching of pattern {'iprimop', _, _, _} tagged with a record name violates the declared type of #c_nil{anno::[any(),...]} | {'c_atom' | 'c_char' | 'c_float' | 'c_int' | 'c_string' | 'c_tuple' | 'c_var' | 'ibinary' | 'icatch' | 'ireceive1',[any(),...] | {_,_,_,_},_} | #c_cons{anno::[any(),...]} | #c_fname{anno::[any(),...]} | #iletrec{anno::{_,_,_,_},defs::[any(),...],body::[any(),...]} | #icase{anno::{_,_,_,_},args::[any()],clauses::[any()],fc::{_,_,_,_,_,_}} | #ireceive2{anno::{_,_,_,_},clauses::[any()],action::[any()]} | #ifun{anno::{_,_,_,_},id::[any(),...],vars::[any()],clauses::[any(),...],fc::{_,_,_,_,_,_}} | #imatch{anno::{_,_,_,_},guard::[],fc::{_,_,_,_,_,_}} | #itry{anno::{_,_,_,_},args::[any()],vars::[any(),...],body::[any(),...],evars::[any(),...],handler::[any(),...]}
+v3_kernel.erl:1381: Call to missing or unexported function erlang:hash/2
diff --git a/lib/dialyzer/test/r9c_SUITE_data/results/mnesia b/lib/dialyzer/test/r9c_SUITE_data/results/mnesia
index bf67447ee7..71acdd9c9e 100644
--- a/lib/dialyzer/test/r9c_SUITE_data/results/mnesia
+++ b/lib/dialyzer/test/r9c_SUITE_data/results/mnesia
@@ -17,6 +17,7 @@ mnesia_frag.erl:294: The call mnesia_frag:remote_collect(Ref::reference(),{'erro
mnesia_frag.erl:304: The call mnesia_frag:remote_collect(Ref::reference(),{'error',{'node_not_running',_}},[],OldSelectFun::fun(() -> [any()])) will never return since it differs in the 2nd argument from the success typing arguments: (reference(),'ok',[any()],fun(() -> [any()]))
mnesia_frag.erl:312: The call mnesia_frag:remote_collect(Ref::reference(),LocalRes::{'error',_},[],OldSelectFun::fun(() -> [any()])) will never return since it differs in the 2nd argument from the success typing arguments: (reference(),'ok',[any()],fun(() -> [any()]))
mnesia_frag_hash.erl:24: Callback info about the mnesia_frag_hash behaviour is not available
+mnesia_frag_old_hash.erl:105: Call to missing or unexported function erlang:hash/2
mnesia_frag_old_hash.erl:23: Callback info about the mnesia_frag_hash behaviour is not available
mnesia_index.erl:52: The call mnesia_lib:other_val(Var::{_,'commit_work' | 'index' | 'setorbag' | 'storage_type' | {'index',_}},_ReASoN_::any()) will never return since it differs in the 1st argument from the success typing arguments: ({_,'active_replicas' | 'where_to_read' | 'where_to_write'},any())
mnesia_lib.erl:1028: The pattern {'EXIT', Reason} can never match the type [any()] | {'error',_}
diff --git a/lib/erl_interface/doc/src/erl_call.xml b/lib/erl_interface/doc/src/erl_call.xml
index f1e52b1889..426f6b88ca 100644
--- a/lib/erl_interface/doc/src/erl_call.xml
+++ b/lib/erl_interface/doc/src/erl_call.xml
@@ -193,7 +193,7 @@ erl_call -s -a 'erlang halt' -n madonna
<p>To apply with many arguments:</p>
<code type="none"><![CDATA[
-erl_call -s -a 'lists map [{math,sqrt},[1,4,9,16,25]]' -n madonna
+erl_call -s -a 'lists seq [1,10]' -n madonna
]]></code>
<p>To evaluate some expressions
diff --git a/lib/kernel/src/os.erl b/lib/kernel/src/os.erl
index c3ffcb3f70..7e83b17add 100644
--- a/lib/kernel/src/os.erl
+++ b/lib/kernel/src/os.erl
@@ -298,12 +298,11 @@ get_data(Port, MonRef, Eot, Sofar) ->
more ->
get_data(Port, MonRef, Eot, [Sofar,Bytes]);
Last ->
- Port ! {self(), close},
- flush_until_closed(Port),
- flush_exit(Port),
+ catch port_close(Port),
+ flush_until_down(Port, MonRef),
iolist_to_binary([Sofar, Last])
end;
- {'DOWN', MonRef, _, _ , _} ->
+ {'DOWN', MonRef, _, _, _} ->
flush_exit(Port),
iolist_to_binary(Sofar)
end.
@@ -317,18 +316,25 @@ eot(Bs, Eot) ->
binary:part(Bs,{0, Pos})
end.
-flush_until_closed(Port) ->
+%% When port_close returns we know that all the
+%% messages sent have been sent and that the
+%% DOWN message is after them all.
+flush_until_down(Port, MonRef) ->
receive
{Port, {data, _Bytes}} ->
- flush_until_closed(Port);
- {Port, closed} ->
- true
+ flush_until_down(Port, MonRef);
+ {'DOWN', MonRef, _, _, _} ->
+ flush_exit(Port)
end.
+%% The exit signal is always delivered before
+%% the down signal, so we can be sure that if there
+%% was an exit message sent, it will be in the
+%% mailbox now.
flush_exit(Port) ->
receive
{'EXIT', Port, _} ->
ok
- after 1 -> % force context switch
+ after 0 ->
ok
end.
diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl
index f368232bfc..1f4591a5a3 100644
--- a/lib/kernel/test/code_SUITE.erl
+++ b/lib/kernel/test/code_SUITE.erl
@@ -621,20 +621,28 @@ sticky_compiler(Files, PrivDir) ->
[R || R <- Rets, R =/= ok].
do_sticky_compile(Mod, Dir) ->
- %% Make sure that the module is loaded. A module being sticky
- %% only prevents it from begin reloaded, not from being loaded
- %% from the wrong place to begin with.
- Mod = Mod:module_info(module),
- File = filename:append(Dir, atom_to_list(Mod)),
- Src = io_lib:format("-module(~s).\n"
- "-export([test/1]).\n"
- "test(me) -> fail.\n", [Mod]),
- ok = file:write_file(File++".erl", Src),
- case c:c(File, [{outdir,Dir}]) of
- {ok,Module} ->
- Module:test(me);
- {error,sticky_directory} ->
- ok
+ case code:is_sticky(Mod) of
+ true ->
+ %% Make sure that the module is loaded. A module being sticky
+ %% only prevents it from begin reloaded, not from being loaded
+ %% from the wrong place to begin with.
+ Mod = Mod:module_info(module),
+ File = filename:append(Dir, atom_to_list(Mod)),
+ Src = io_lib:format("-module(~s).\n"
+ "-export([test/1]).\n"
+ "test(me) -> fail.\n", [Mod]),
+ ok = file:write_file(File++".erl", Src),
+ case c:c(File, [{outdir,Dir}]) of
+ {ok,Module} ->
+ Module:test(me);
+ {error,sticky_directory} ->
+ ok
+ end;
+ false ->
+ %% For some reason the module is not sticky
+ %% could be that the .erlang file has
+ %% unstuck it?
+ {Mod, is_not_sticky}
end.
%% Test that the -pa and -pz options work as expected.
diff --git a/lib/ssh/src/ssh_cli.erl b/lib/ssh/src/ssh_cli.erl
index 8af0ecc5f9..6f8c050486 100644
--- a/lib/ssh/src/ssh_cli.erl
+++ b/lib/ssh/src/ssh_cli.erl
@@ -453,14 +453,20 @@ move_cursor(From, To, #ssh_pty{width=Width, term=Type}) ->
%% %%% make sure that there is data to send
%% %%% before calling ssh_connection:send
write_chars(ConnectionHandler, ChannelId, Chars) ->
- case erlang:iolist_size(Chars) of
- 0 ->
- ok;
- _ ->
- ssh_connection:send(ConnectionHandler, ChannelId,
- ?SSH_EXTENDED_DATA_DEFAULT, Chars)
+ case has_chars(Chars) of
+ false -> ok;
+ true -> ssh_connection:send(ConnectionHandler,
+ ChannelId,
+ ?SSH_EXTENDED_DATA_DEFAULT,
+ Chars)
end.
+has_chars([C|_]) when is_integer(C) -> true;
+has_chars([H|T]) when is_list(H) ; is_binary(H) -> has_chars(H) orelse has_chars(T);
+has_chars(<<_:8,_/binary>>) -> true;
+has_chars(_) -> false.
+
+
%%% tail, works with empty lists
tl1([_|A]) -> A;
tl1(_) -> [].
diff --git a/lib/ssh/src/ssh_sftpd.erl b/lib/ssh/src/ssh_sftpd.erl
index b739955836..9352046795 100644
--- a/lib/ssh/src/ssh_sftpd.erl
+++ b/lib/ssh/src/ssh_sftpd.erl
@@ -664,29 +664,25 @@ open(Vsn, ReqId, Data, State) when Vsn >= 4 ->
do_open(ReqId, State, Path, Flags).
do_open(ReqId, State0, Path, Flags) ->
- #state{file_handler = FileMod, file_state = FS0, root = Root, xf = #ssh_xfer{vsn = Vsn}} = State0,
- XF = State0#state.xf,
- F = [binary | Flags],
- {IsDir, _FS1} = FileMod:is_dir(Path, FS0),
+ #state{file_handler = FileMod, file_state = FS0, xf = #ssh_xfer{vsn = Vsn}} = State0,
+ AbsPath = relate_file_name(Path, State0),
+ {IsDir, _FS1} = FileMod:is_dir(AbsPath, FS0),
case IsDir of
true when Vsn > 5 ->
ssh_xfer:xf_send_status(State0#state.xf, ReqId,
- ?SSH_FX_FILE_IS_A_DIRECTORY, "File is a directory");
+ ?SSH_FX_FILE_IS_A_DIRECTORY, "File is a directory"),
+ State0;
true ->
ssh_xfer:xf_send_status(State0#state.xf, ReqId,
- ?SSH_FX_FAILURE, "File is a directory");
+ ?SSH_FX_FAILURE, "File is a directory"),
+ State0;
false ->
- AbsPath = case Root of
- "" ->
- Path;
- _ ->
- relate_file_name(Path, State0)
- end,
- {Res, FS1} = FileMod:open(AbsPath, F, FS0),
+ OpenFlags = [binary | Flags],
+ {Res, FS1} = FileMod:open(AbsPath, OpenFlags, FS0),
State1 = State0#state{file_state = FS1},
case Res of
{ok, IoDevice} ->
- add_handle(State1, XF, ReqId, file, {Path,IoDevice});
+ add_handle(State1, State0#state.xf, ReqId, file, {Path,IoDevice});
{error, Error} ->
ssh_xfer:xf_send_status(State1#state.xf, ReqId,
ssh_xfer:encode_erlang_status(Error)),
@@ -742,6 +738,10 @@ resolve_symlinks_2([], State, _LinkCnt, AccPath) ->
{{ok, AccPath}, State}.
+%% The File argument is always in a user visible file system, i.e.
+%% is under Root and is relative to CWD or Root, if starts with "/".
+%% The result of the function is always an absolute path in a
+%% "backend" file system.
relate_file_name(File, State) ->
relate_file_name(File, State, _Canonicalize=true).
@@ -749,19 +749,20 @@ relate_file_name(File, State, Canonicalize) when is_binary(File) ->
relate_file_name(unicode:characters_to_list(File), State, Canonicalize);
relate_file_name(File, #state{cwd = CWD, root = ""}, Canonicalize) ->
relate_filename_to_path(File, CWD, Canonicalize);
-relate_file_name(File, #state{root = Root}, Canonicalize) ->
- case is_within_root(Root, File) of
- true ->
- File;
- false ->
- RelFile = make_relative_filename(File),
- NewFile = relate_filename_to_path(RelFile, Root, Canonicalize),
- case is_within_root(Root, NewFile) of
- true ->
- NewFile;
- false ->
- Root
- end
+relate_file_name(File, #state{cwd = CWD, root = Root}, Canonicalize) ->
+ CWD1 = case is_within_root(Root, CWD) of
+ true -> CWD;
+ false -> Root
+ end,
+ AbsFile = case make_relative_filename(File) of
+ File ->
+ relate_filename_to_path(File, CWD1, Canonicalize);
+ RelFile ->
+ relate_filename_to_path(RelFile, Root, Canonicalize)
+ end,
+ case is_within_root(Root, AbsFile) of
+ true -> AbsFile;
+ false -> Root
end.
is_within_root(Root, File) ->
diff --git a/lib/ssh/test/ssh_sftpd_SUITE.erl b/lib/ssh/test/ssh_sftpd_SUITE.erl
index 52a26110c4..6d18a980ee 100644
--- a/lib/ssh/test/ssh_sftpd_SUITE.erl
+++ b/lib/ssh/test/ssh_sftpd_SUITE.erl
@@ -65,7 +65,12 @@ all() ->
ver3_open_flags,
relpath,
sshd_read_file,
- ver6_basic].
+ ver6_basic,
+ access_outside_root,
+ root_with_cwd,
+ relative_path,
+ open_file_dir_v5,
+ open_file_dir_v6].
groups() ->
[].
@@ -117,6 +122,31 @@ init_per_testcase(TestCase, Config) ->
ver6_basic ->
SubSystems = [ssh_sftpd:subsystem_spec([{sftpd_vsn, 6}])],
ssh:daemon(0, [{subsystems, SubSystems}|Options]);
+ access_outside_root ->
+ %% Build RootDir/access_outside_root/a/b and set Root and CWD
+ BaseDir = filename:join(PrivDir, access_outside_root),
+ RootDir = filename:join(BaseDir, a),
+ CWD = filename:join(RootDir, b),
+ %% Make the directory chain:
+ ok = filelib:ensure_dir(filename:join(CWD, tmp)),
+ SubSystems = [ssh_sftpd:subsystem_spec([{root, RootDir},
+ {cwd, CWD}])],
+ ssh:daemon(0, [{subsystems, SubSystems}|Options]);
+ root_with_cwd ->
+ RootDir = filename:join(PrivDir, root_with_cwd),
+ CWD = filename:join(RootDir, home),
+ SubSystems = [ssh_sftpd:subsystem_spec([{root, RootDir}, {cwd, CWD}])],
+ ssh:daemon(0, [{subsystems, SubSystems}|Options]);
+ relative_path ->
+ SubSystems = [ssh_sftpd:subsystem_spec([{cwd, PrivDir}])],
+ ssh:daemon(0, [{subsystems, SubSystems}|Options]);
+ open_file_dir_v5 ->
+ SubSystems = [ssh_sftpd:subsystem_spec([{cwd, PrivDir}])],
+ ssh:daemon(0, [{subsystems, SubSystems}|Options]);
+ open_file_dir_v6 ->
+ SubSystems = [ssh_sftpd:subsystem_spec([{cwd, PrivDir},
+ {sftpd_vsn, 6}])],
+ ssh:daemon(0, [{subsystems, SubSystems}|Options]);
_ ->
SubSystems = [ssh_sftpd:subsystem_spec([])],
ssh:daemon(0, [{subsystems, SubSystems}|Options])
@@ -646,6 +676,133 @@ ver6_basic(Config) when is_list(Config) ->
open_file(PrivDir, Cm, Channel, ReqId,
?ACE4_READ_DATA bor ?ACE4_READ_ATTRIBUTES,
?SSH_FXF_OPEN_EXISTING).
+
+%%--------------------------------------------------------------------
+access_outside_root() ->
+ [{doc, "Try access files outside the tree below RootDir"}].
+access_outside_root(Config) when is_list(Config) ->
+ PrivDir = proplists:get_value(priv_dir, Config),
+ BaseDir = filename:join(PrivDir, access_outside_root),
+ %% A file outside the tree below RootDir which is BaseDir/a
+ %% Make the file BaseDir/bad :
+ BadFilePath = filename:join([BaseDir, bad]),
+ ok = file:write_file(BadFilePath, <<>>),
+ {Cm, Channel} = proplists:get_value(sftp, Config),
+ %% Try to access a file parallell to the RootDir:
+ try_access("/../bad", Cm, Channel, 0),
+ %% Try to access the same file via the CWD which is /b relative to the RootDir:
+ try_access("../../bad", Cm, Channel, 1).
+
+
+try_access(Path, Cm, Channel, ReqId) ->
+ Return =
+ open_file(Path, Cm, Channel, ReqId,
+ ?ACE4_READ_DATA bor ?ACE4_READ_ATTRIBUTES,
+ ?SSH_FXF_OPEN_EXISTING),
+ ct:log("Try open ~p -> ~p",[Path,Return]),
+ case Return of
+ {ok, <<?SSH_FXP_HANDLE, ?UINT32(ReqId), _Handle0/binary>>, _} ->
+ ct:fail("Could open a file outside the root tree!");
+ {ok, <<?SSH_FXP_STATUS, ?UINT32(ReqId), ?UINT32(Code), Rest/binary>>, <<>>} ->
+ case Code of
+ ?SSH_FX_FILE_IS_A_DIRECTORY ->
+ ct:pal("Got the expected SSH_FX_FILE_IS_A_DIRECTORY status",[]),
+ ok;
+ ?SSH_FX_FAILURE ->
+ ct:pal("Got the expected SSH_FX_FAILURE status",[]),
+ ok;
+ _ ->
+ case Rest of
+ <<?UINT32(Len), Txt:Len/binary, _/binary>> ->
+ ct:fail("Got unexpected SSH_FX_code: ~p (~p)",[Code,Txt]);
+ _ ->
+ ct:fail("Got unexpected SSH_FX_code: ~p",[Code])
+ end
+ end;
+ _ ->
+ ct:fail("Completly unexpected return: ~p", [Return])
+ end.
+
+%%--------------------------------------------------------------------
+root_with_cwd() ->
+ [{doc, "Check if files are found, if the CWD and Root are specified"}].
+root_with_cwd(Config) when is_list(Config) ->
+ PrivDir = proplists:get_value(priv_dir, Config),
+ RootDir = filename:join(PrivDir, root_with_cwd),
+ CWD = filename:join(RootDir, home),
+ FileName = "root_with_cwd.txt",
+ FilePath = filename:join(CWD, FileName),
+ ok = filelib:ensure_dir(FilePath),
+ ok = file:write_file(FilePath ++ "0", <<>>),
+ ok = file:write_file(FilePath ++ "1", <<>>),
+ ok = file:write_file(FilePath ++ "2", <<>>),
+ {Cm, Channel} = proplists:get_value(sftp, Config),
+ ReqId0 = 0,
+ {ok, <<?SSH_FXP_HANDLE, ?UINT32(ReqId0), _Handle0/binary>>, _} =
+ open_file(FileName ++ "0", Cm, Channel, ReqId0,
+ ?ACE4_READ_DATA bor ?ACE4_READ_ATTRIBUTES,
+ ?SSH_FXF_OPEN_EXISTING),
+ ReqId1 = 1,
+ {ok, <<?SSH_FXP_HANDLE, ?UINT32(ReqId1), _Handle1/binary>>, _} =
+ open_file("./" ++ FileName ++ "1", Cm, Channel, ReqId1,
+ ?ACE4_READ_DATA bor ?ACE4_READ_ATTRIBUTES,
+ ?SSH_FXF_OPEN_EXISTING),
+ ReqId2 = 2,
+ {ok, <<?SSH_FXP_HANDLE, ?UINT32(ReqId2), _Handle2/binary>>, _} =
+ open_file("/home/" ++ FileName ++ "2", Cm, Channel, ReqId2,
+ ?ACE4_READ_DATA bor ?ACE4_READ_ATTRIBUTES,
+ ?SSH_FXF_OPEN_EXISTING).
+
+%%--------------------------------------------------------------------
+relative_path() ->
+ [{doc, "Test paths relative to CWD when opening a file handle."}].
+relative_path(Config) when is_list(Config) ->
+ PrivDir = proplists:get_value(priv_dir, Config),
+ FileName = "test_relative_path.txt",
+ FilePath = filename:join(PrivDir, FileName),
+ ok = filelib:ensure_dir(FilePath),
+ ok = file:write_file(FilePath, <<>>),
+ {Cm, Channel} = proplists:get_value(sftp, Config),
+ ReqId = 0,
+ {ok, <<?SSH_FXP_HANDLE, ?UINT32(ReqId), _Handle/binary>>, _} =
+ open_file(FileName, Cm, Channel, ReqId,
+ ?ACE4_READ_DATA bor ?ACE4_READ_ATTRIBUTES,
+ ?SSH_FXF_OPEN_EXISTING).
+
+%%--------------------------------------------------------------------
+open_file_dir_v5() ->
+ [{doc, "Test if open_file fails when opening existing directory."}].
+open_file_dir_v5(Config) when is_list(Config) ->
+ PrivDir = proplists:get_value(priv_dir, Config),
+ FileName = "open_file_dir_v5",
+ FilePath = filename:join(PrivDir, FileName),
+ ok = filelib:ensure_dir(FilePath),
+ ok = file:make_dir(FilePath),
+ {Cm, Channel} = proplists:get_value(sftp, Config),
+ ReqId = 0,
+ {ok, <<?SSH_FXP_STATUS, ?UINT32(ReqId),
+ ?UINT32(?SSH_FX_FAILURE), _/binary>>, _} =
+ open_file(FileName, Cm, Channel, ReqId,
+ ?ACE4_READ_DATA bor ?ACE4_READ_ATTRIBUTES,
+ ?SSH_FXF_OPEN_EXISTING).
+
+%%--------------------------------------------------------------------
+open_file_dir_v6() ->
+ [{doc, "Test if open_file fails when opening existing directory."}].
+open_file_dir_v6(Config) when is_list(Config) ->
+ PrivDir = proplists:get_value(priv_dir, Config),
+ FileName = "open_file_dir_v6",
+ FilePath = filename:join(PrivDir, FileName),
+ ok = filelib:ensure_dir(FilePath),
+ ok = file:make_dir(FilePath),
+ {Cm, Channel} = proplists:get_value(sftp, Config),
+ ReqId = 0,
+ {ok, <<?SSH_FXP_STATUS, ?UINT32(ReqId),
+ ?UINT32(?SSH_FX_FILE_IS_A_DIRECTORY), _/binary>>, _} =
+ open_file(FileName, Cm, Channel, ReqId,
+ ?ACE4_READ_DATA bor ?ACE4_READ_ATTRIBUTES,
+ ?SSH_FXF_OPEN_EXISTING).
+
%%--------------------------------------------------------------------
%% Internal functions ------------------------------------------------
%%--------------------------------------------------------------------
@@ -688,9 +845,7 @@ reply(Cm, Channel, RBuf) ->
30000 -> ct:fail("timeout ~p:~p",[?MODULE,?LINE])
end.
-
open_file(File, Cm, Channel, ReqId, Access, Flags) ->
-
Data = list_to_binary([?uint32(ReqId),
?binary(list_to_binary(File)),
?uint32(Access),
diff --git a/lib/ssh/test/ssh_to_openssh_SUITE.erl b/lib/ssh/test/ssh_to_openssh_SUITE.erl
index 425b4d20f2..4d5e5be2a1 100644
--- a/lib/ssh/test/ssh_to_openssh_SUITE.erl
+++ b/lib/ssh/test/ssh_to_openssh_SUITE.erl
@@ -36,7 +36,7 @@
%%--------------------------------------------------------------------
suite() ->
- [{timetrap,{seconds,20}}].
+ [{timetrap,{seconds,60}}].
all() ->
case os:find_executable("ssh") of
diff --git a/lib/ssl/doc/src/ssl_session_cache_api.xml b/lib/ssl/doc/src/ssl_session_cache_api.xml
index b85d8fb284..1b41eae89d 100644
--- a/lib/ssl/doc/src/ssl_session_cache_api.xml
+++ b/lib/ssl/doc/src/ssl_session_cache_api.xml
@@ -11,7 +11,7 @@
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at
-
+
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing, software
@@ -62,8 +62,8 @@
</taglist>
</section>
-
- <funcs>
+
+ <funcs>
<func>
<name>delete(Cache, Key) -> _</name>
@@ -134,7 +134,7 @@
</p>
</desc>
</func>
-
+
<func>
<name>select_session(Cache, PartialKey) -> [session()]</name>
<fsummary>Selects sessions that can be reused.</fsummary>
@@ -151,6 +151,21 @@
</func>
<func>
+ <name>size(Cache) -> integer()</name>
+ <fsummary>Returns the number of sessions in the cache.</fsummary>
+ <type>
+ <v>Cache = cache_ref()</v>
+ </type>
+ <desc>
+ <p>Returns the number of sessions in the cache. If size
+ exceeds the maximum number of sessions, the current cache
+ entries will be invalidated regardless of their remaining
+ lifetime. Is to be callable from any process.
+ </p>
+ </desc>
+ </func>
+
+ <func>
<name>terminate(Cache) -> _</name>
<fsummary>Called by the process that handles the cache when it
is about to terminate.</fsummary>
@@ -178,7 +193,7 @@
</p>
</desc>
</func>
-
- </funcs>
-
+
+ </funcs>
+
</erlref>
diff --git a/lib/ssl/src/tls_v1.erl b/lib/ssl/src/tls_v1.erl
index e2e224ab0c..f52ee06e71 100644
--- a/lib/ssl/src/tls_v1.erl
+++ b/lib/ssl/src/tls_v1.erl
@@ -204,21 +204,21 @@ suites(Minor) when Minor == 1; Minor == 2 ->
?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA,
?TLS_RSA_WITH_AES_256_CBC_SHA,
- ?TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA,
- ?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA,
- ?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA,
- ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA,
- ?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA,
- ?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA,
- ?TLS_RSA_WITH_3DES_EDE_CBC_SHA,
-
?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA,
?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA,
?TLS_DHE_RSA_WITH_AES_128_CBC_SHA,
?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_RSA_WITH_AES_128_CBC_SHA,
+
+ ?TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA,
+ ?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA,
+ ?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA,
+ ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA,
+ ?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA,
+ ?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA,
+ ?TLS_RSA_WITH_3DES_EDE_CBC_SHA
];
suites(3) ->
[
diff --git a/lib/stdlib/doc/src/filename.xml b/lib/stdlib/doc/src/filename.xml
index 7acef51ca1..0ccca37a9d 100644
--- a/lib/stdlib/doc/src/filename.xml
+++ b/lib/stdlib/doc/src/filename.xml
@@ -513,6 +513,33 @@ true
</func>
<func>
+ <name name="safe_relative_path" arity="1"/>
+ <fsummary>Sanitize a relative path to avoid directory traversal attacks.</fsummary>
+ <desc>
+ <p>Sanitizes the relative path by eliminating ".." and "."
+ components to protect against directory traversal attacks.
+ Either returns the sanitized path name, or the atom
+ <c>unsafe</c> if the path is unsafe.
+ The path is considered unsafe in the following circumstances:</p>
+ <list type="bulleted">
+ <item><p>The path is not relative.</p></item>
+ <item><p>A ".." component would climb up above the root of
+ the relative path.</p></item>
+ </list>
+ <p><em>Examples:</em></p>
+ <pre>
+1> <input>filename:safe_relative_path("dir/sub_dir/..").</input>
+"dir"
+2> <input>filename:safe_relative_path("dir/..").</input>
+[]
+3> <input>filename:safe_relative_path("dir/../..").</input>
+unsafe
+4> <input>filename:safe_relative_path("/abs/path").</input>
+unsafe</pre>
+ </desc>
+ </func>
+
+ <func>
<name name="split" arity="1"/>
<fsummary>Split a filename into its path components.</fsummary>
<desc>
diff --git a/lib/stdlib/src/c.erl b/lib/stdlib/src/c.erl
index d3f9a9c7af..52df2319dd 100644
--- a/lib/stdlib/src/c.erl
+++ b/lib/stdlib/src/c.erl
@@ -35,7 +35,7 @@
-export([appcall/4]).
-import(lists, [reverse/1,flatten/1,sublist/3,sort/1,keysort/2,
- concat/1,max/1,min/1,foreach/2,foldl/3,flatmap/2]).
+ max/1,min/1,foreach/2,foldl/3,flatmap/2]).
-import(io, [format/1, format/2]).
%%-----------------------------------------------------------------------
@@ -83,9 +83,11 @@ c(Module) -> c(Module, []).
-spec c(Module, Options) -> {'ok', ModuleName} | 'error' when
Module :: file:name(),
- Options :: [compile:option()],
+ Options :: [compile:option()] | compile:option(),
ModuleName :: module().
+c(Module, SingleOption) when not is_list(SingleOption) ->
+ c(Module, [SingleOption]);
c(Module, Opts) when is_atom(Module) ->
%% either a module name or a source file name (possibly without
%% suffix); if such a source file exists, it is used to compile from
diff --git a/lib/stdlib/src/filename.erl b/lib/stdlib/src/filename.erl
index 2a2f25dcd2..b5df5c9d37 100644
--- a/lib/stdlib/src/filename.erl
+++ b/lib/stdlib/src/filename.erl
@@ -37,7 +37,8 @@
-export([absname/1, absname/2, absname_join/2,
basename/1, basename/2, dirname/1,
extension/1, join/1, join/2, pathtype/1,
- rootname/1, rootname/2, split/1, flatten/1, nativename/1]).
+ rootname/1, rootname/2, split/1, flatten/1, nativename/1,
+ safe_relative_path/1]).
-export([find_src/1, find_src/2]). % deprecated
-export([basedir/2, basedir/3]).
@@ -753,12 +754,46 @@ separators() ->
_ -> {false, false}
end.
+-spec safe_relative_path(Filename) -> 'unsafe' | SafeFilename when
+ Filename :: file:name_all(),
+ SafeFilename :: file:name_all().
+
+safe_relative_path(Path) ->
+ case pathtype(Path) of
+ relative ->
+ Cs0 = split(Path),
+ safe_relative_path_1(Cs0, []);
+ _ ->
+ unsafe
+ end.
+
+safe_relative_path_1(["."|T], Acc) ->
+ safe_relative_path_1(T, Acc);
+safe_relative_path_1([<<".">>|T], Acc) ->
+ safe_relative_path_1(T, Acc);
+safe_relative_path_1([".."|T], Acc) ->
+ climb(T, Acc);
+safe_relative_path_1([<<"..">>|T], Acc) ->
+ climb(T, Acc);
+safe_relative_path_1([H|T], Acc) ->
+ safe_relative_path_1(T, [H|Acc]);
+safe_relative_path_1([], []) ->
+ [];
+safe_relative_path_1([], Acc) ->
+ join(lists:reverse(Acc)).
+
+climb(_, []) ->
+ unsafe;
+climb(T, [_|Acc]) ->
+ safe_relative_path_1(T, Acc).
+
%% NOTE: The find_src/1/2 functions are deprecated; they try to do too much
%% at once and are not a good fit for this module. Parts of the code have
%% been moved to filelib:find_file/2 instead. Only this part of this
%% module is allowed to call the filelib module; such mutual dependency
%% should otherwise be avoided! This code should eventually be removed.
%%
+
%% find_src(Module) --
%% find_src(Module, Rules) --
%%
diff --git a/lib/stdlib/src/io_lib_pretty.erl b/lib/stdlib/src/io_lib_pretty.erl
index 94376408d1..6ddba8121a 100644
--- a/lib/stdlib/src/io_lib_pretty.erl
+++ b/lib/stdlib/src/io_lib_pretty.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -139,6 +139,10 @@ max_cs(M, _Len) ->
M.
-define(ATM(T), is_list(element(1, T))).
+-define(ATM_PAIR(Pair),
+ ?ATM(element(2, element(1, Pair))) % Key
+ andalso
+ ?ATM(element(3, element(1, Pair)))). % Value
-define(ATM_FLD(Field), ?ATM(element(4, element(1, Field)))).
pp({_S, Len} = If, Col, Ll, M, _TInd, _Ind, LD, W)
@@ -151,9 +155,8 @@ pp({{tuple,true,L}, _Len}, Col, Ll, M, TInd, Ind, LD, W) ->
pp({{tuple,false,L}, _Len}, Col, Ll, M, TInd, Ind, LD, W) ->
[${, pp_list(L, Col + 1, Ll, M, TInd, indent(1, Ind), LD, $,, W + 1), $}];
pp({{map,Pairs},_Len}, Col, Ll, M, TInd, Ind, LD, W) ->
- [$#,${, pp_list(Pairs, Col + 2, Ll, M, TInd, indent(2, Ind), LD, $,, W + 1), $}];
-pp({{map_pair,K,V},_Len}, Col, Ll, M, TInd, Ind, LD, W) ->
- [pp(K, Col, Ll, M, TInd, Ind, LD, W), " => ", pp(V, Col, Ll, M, TInd, Ind, LD, W)];
+ [$#, ${, pp_map(Pairs, Col + 2, Ll, M, TInd, indent(2, Ind), LD, W + 1),
+ $}];
pp({{record,[{Name,NLen} | L]}, _Len}, Col, Ll, M, TInd, Ind, LD, W) ->
[Name, ${, pp_record(L, NLen, Col, Ll, M, TInd, Ind, LD, W + NLen+1), $}];
pp({{bin,S}, _Len}, Col, Ll, M, _TInd, Ind, LD, W) ->
@@ -178,6 +181,46 @@ pp_tag_tuple([{Tag,Tlen} | L], Col, Ll, M, TInd, Ind, LD, W) ->
[Tag, S | pp_list(L, Tcol, Ll, M, TInd, Indent, LD, S, W+Tlen+1)]
end.
+pp_map([], _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
+ "";
+pp_map({dots, _}, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
+ "...";
+pp_map([P | Ps], Col, Ll, M, TInd, Ind, LD, W) ->
+ {PS, PW} = pp_pair(P, Col, Ll, M, TInd, Ind, last_depth(Ps, LD), W),
+ [PS | pp_pairs_tail(Ps, Col, Col + PW, Ll, M, TInd, Ind, LD, PW)].
+
+pp_pairs_tail([], _Col0, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
+ "";
+pp_pairs_tail({dots, _}, _Col0, _Col, _M, _Ll, _TInd, _Ind, _LD, _W) ->
+ ",...";
+pp_pairs_tail([{_, Len}=P | Ps], Col0, Col, Ll, M, TInd, Ind, LD, W) ->
+ LD1 = last_depth(Ps, LD),
+ ELen = 1 + Len,
+ if
+ LD1 =:= 0, ELen + 1 < Ll - Col, W + ELen + 1 =< M, ?ATM_PAIR(P);
+ LD1 > 0, ELen < Ll - Col - LD1, W + ELen + LD1 =< M, ?ATM_PAIR(P) ->
+ [$,, write_pair(P) |
+ pp_pairs_tail(Ps, Col0, Col+ELen, Ll, M, TInd, Ind, LD, W+ELen)];
+ true ->
+ {PS, PW} = pp_pair(P, Col0, Ll, M, TInd, Ind, LD1, 0),
+ [$,, $\n, Ind, PS |
+ pp_pairs_tail(Ps, Col0, Col0 + PW, Ll, M, TInd, Ind, LD, PW)]
+ end.
+
+pp_pair({_, Len}=Pair, Col, Ll, M, _TInd, _Ind, LD, W)
+ when Len < Ll - Col - LD, Len + W + LD =< M ->
+ {write_pair(Pair), if
+ ?ATM_PAIR(Pair) ->
+ Len;
+ true ->
+ Ll % force nl
+ end};
+pp_pair({{map_pair, K, V}, _Len}, Col0, Ll, M, TInd, Ind0, LD, W) ->
+ I = map_value_indent(TInd),
+ Ind = indent(I, Ind0),
+ {[pp(K, Col0, Ll, M, TInd, Ind0, LD, W), " =>\n",
+ Ind | pp(V, Col0 + I, Ll, M, TInd, Ind, LD, 0)], Ll}. % force nl
+
pp_record([], _Nlen, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
"";
pp_record({dots, _}, _Nlen, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
@@ -216,7 +259,11 @@ pp_field({_, Len}=Fl, Col, Ll, M, _TInd, _Ind, LD, W)
end};
pp_field({{field, Name, NameL, F}, _Len}, Col0, Ll, M, TInd, Ind0, LD, W0) ->
{Col, Ind, S, W} = rec_indent(NameL, TInd, Col0, Ind0, W0 + NameL),
- {[Name, " = ", S | pp(F, Col, Ll, M, TInd, Ind, LD, W)], Ll}. % force nl
+ Sep = case S of
+ [$\n | _] -> " =";
+ _ -> " = "
+ end,
+ {[Name, Sep, S | pp(F, Col, Ll, M, TInd, Ind, LD, W)], Ll}. % force nl
rec_indent(RInd, TInd, Col0, Ind0, W0) ->
%% this uses TInd
@@ -305,8 +352,8 @@ write({{list, L}, _}) ->
[$[, write_list(L, $|), $]];
write({{map, Pairs}, _}) ->
[$#,${, write_list(Pairs, $,), $}];
-write({{map_pair, K, V}, _}) ->
- [write(K)," => ",write(V)];
+write({{map_pair, _K, _V}, _}=Pair) ->
+ write_pair(Pair);
write({{record, [{Name,_} | L]}, _}) ->
[Name, ${, write_fields(L), $}];
write({{bin, S}, _}) ->
@@ -314,6 +361,9 @@ write({{bin, S}, _}) ->
write({S, _}) ->
S.
+write_pair({{map_pair, K, V}, _}) ->
+ [write(K), " => ", write(V)].
+
write_fields([]) ->
"";
write_fields({dots, _}) ->
@@ -347,7 +397,7 @@ write_tail(E, S) ->
%% The depth (D) is used for extracting and counting the characters to
%% print. The structure is kept so that the returned intermediate
-%% format can be formatted. The separators (list, tuple, record) are
+%% format can be formatted. The separators (list, tuple, record, map) are
%% counted but need to be added later.
%% D =/= 0
@@ -423,21 +473,32 @@ print_length(Term, _D, _RF, _Enc, _Str) ->
print_length_map(_Map, 1, _RF, _Enc, _Str) ->
{"#{...}", 6};
print_length_map(Map, D, RF, Enc, Str) when is_map(Map) ->
- Pairs = print_length_map_pairs(maps:to_list(Map), D, RF, Enc, Str),
+ Pairs = print_length_map_pairs(maps_to_list(Map, D), D, RF, Enc, Str),
{{map, Pairs}, list_length(Pairs, 3)}.
+maps_to_list(Map, D) when D < 0; map_size(Map) =< D ->
+ maps:to_list(Map);
+maps_to_list(Map, D) ->
+ F = fun(_K, _V, {N, L}) when N =:= D ->
+ throw(L);
+ (K, V, {N, L}) ->
+ {N+1, [{K, V} | L]}
+ end,
+ lists:reverse(catch maps:fold(F, {0, []}, Map)).
+
print_length_map_pairs([], _D, _RF, _Enc, _Str) ->
[];
print_length_map_pairs(_Pairs, 1, _RF, _Enc, _Str) ->
{dots, 3};
-print_length_map_pairs([{K,V}|Pairs], D, RF, Enc, Str) ->
- [print_length_map_pair(K,V,D-1,RF,Enc,Str) |
- print_length_map_pairs(Pairs,D-1,RF,Enc,Str)].
+print_length_map_pairs([{K, V} | Pairs], D, RF, Enc, Str) ->
+ [print_length_map_pair(K, V, D - 1, RF, Enc, Str) |
+ print_length_map_pairs(Pairs, D - 1, RF, Enc, Str)].
print_length_map_pair(K, V, D, RF, Enc, Str) ->
{KS, KL} = print_length(K, D, RF, Enc, Str),
{VS, VL} = print_length(V, D, RF, Enc, Str),
- {{map_pair, {KS,KL}, {VS,VL}}, KL + VL}.
+ KL1 = KL + 4,
+ {{map_pair, {KS, KL1}, {VS, VL}}, KL1 + VL}.
print_length_tuple(_Tuple, 1, _RF, _Enc, _Str) ->
{"{...}", 5};
@@ -630,6 +691,8 @@ cind({{tuple,true,L}, _Len}, Col, Ll, M, Ind, LD, W) ->
cind_tag_tuple(L, Col, Ll, M, Ind, LD, W + 1);
cind({{tuple,false,L}, _Len}, Col, Ll, M, Ind, LD, W) ->
cind_list(L, Col + 1, Ll, M, Ind, LD, W + 1);
+cind({{map,Pairs},_Len}, Col, Ll, M, Ind, LD, W) ->
+ cind_map(Pairs, Col + 2, Ll, M, Ind, LD, W + 2);
cind({{record,[{_Name,NLen} | L]}, _Len}, Col, Ll, M, Ind, LD, W) ->
cind_record(L, NLen, Col, Ll, M, Ind, LD, W + NLen + 1);
cind({{bin,_S}, _Len}, _Col, _Ll, _M, Ind, _LD, _W) ->
@@ -655,6 +718,48 @@ cind_tag_tuple([{_Tag,Tlen} | L], Col, Ll, M, Ind, LD, W) ->
throw(no_good)
end.
+cind_map([P | Ps], Col, Ll, M, Ind, LD, W) ->
+ PW = cind_pair(P, Col, Ll, M, Ind, last_depth(Ps, LD), W),
+ cind_pairs_tail(Ps, Col, Col + PW, Ll, M, Ind, LD, W + PW);
+cind_map(_, _Col, _Ll, _M, Ind, _LD, _W) ->
+ Ind.
+
+cind_pairs_tail([{_, Len}=P | Ps], Col0, Col, Ll, M, Ind, LD, W) ->
+ LD1 = last_depth(Ps, LD),
+ ELen = 1 + Len,
+ if
+ LD1 =:= 0, ELen + 1 < Ll - Col, W + ELen + 1 =< M, ?ATM_PAIR(P);
+ LD1 > 0, ELen < Ll - Col - LD1, W + ELen + LD1 =< M, ?ATM_PAIR(P) ->
+ cind_pairs_tail(Ps, Col0, Col + ELen, Ll, M, Ind, LD, W + ELen);
+ true ->
+ PW = cind_pair(P, Col0, Ll, M, Ind, LD1, 0),
+ cind_pairs_tail(Ps, Col0, Col0 + PW, Ll, M, Ind, LD, PW)
+ end;
+cind_pairs_tail(_, _Col0, _Col, _Ll, _M, Ind, _LD, _W) ->
+ Ind.
+
+cind_pair({{map_pair, _Key, _Value}, Len}=Pair, Col, Ll, M, _Ind, LD, W)
+ when Len < Ll - Col - LD, Len + W + LD =< M ->
+ if
+ ?ATM_PAIR(Pair) ->
+ Len;
+ true ->
+ Ll
+ end;
+cind_pair({{map_pair, K, V}, _Len}, Col0, Ll, M, Ind, LD, W0) ->
+ cind(K, Col0, Ll, M, Ind, LD, W0),
+ I = map_value_indent(Ind),
+ cind(V, Col0 + I, Ll, M, Ind, LD, 0),
+ Ll.
+
+map_value_indent(TInd) ->
+ case TInd > 0 of
+ true ->
+ TInd;
+ false ->
+ 4
+ end.
+
cind_record([F | Fs], Nlen, Col0, Ll, M, Ind, LD, W0) ->
Nind = Nlen + 1,
{Col, W} = cind_rec(Nind, Col0, Ll, M, Ind, W0),
diff --git a/lib/stdlib/src/sofs.erl b/lib/stdlib/src/sofs.erl
index c244e06ca4..cc50e1b52c 100644
--- a/lib/stdlib/src/sofs.erl
+++ b/lib/stdlib/src/sofs.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2001-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2001-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -76,7 +76,7 @@
%%
%% See also "Naive Set Theory" by Paul R. Halmos.
%%
-%% By convention, erlang:error/2 is called from exported functions.
+%% By convention, erlang:error/1 is called from exported functions.
-define(TAG, 'Set').
-define(ORDTAG, 'OrdSet').
@@ -87,12 +87,6 @@
-define(LIST(S), (S)#?TAG.data).
-define(TYPE(S), (S)#?TAG.type).
-%%-define(SET(L, T),
-%% case is_type(T) of
-%% true -> #?TAG{data = L, type = T};
-%% false -> erlang:error(badtype, [T])
-%% end
-%% ).
-define(SET(L, T), #?TAG{data = L, type = T}).
-define(IS_SET(S), is_record(S, ?TAG)).
-define(IS_UNTYPED_SET(S), ?TYPE(S) =:= ?ANYTYPE).
@@ -154,11 +148,8 @@ from_term(T) ->
_ when is_list(T) -> [?ANYTYPE];
_ -> ?ANYTYPE
end,
- case catch setify(T, Type) of
- {'EXIT', _} ->
- erlang:error(badarg, [T]);
- Set ->
- Set
+ try setify(T, Type)
+ catch _:_ -> erlang:error(badarg)
end.
-spec(from_term(Term, Type) -> AnySet when
@@ -168,14 +159,11 @@ from_term(T) ->
from_term(L, T) ->
case is_type(T) of
true ->
- case catch setify(L, T) of
- {'EXIT', _} ->
- erlang:error(badarg, [L, T]);
- Set ->
- Set
+ try setify(L, T)
+ catch _:_ -> erlang:error(badarg)
end;
false ->
- erlang:error(badarg, [L, T])
+ erlang:error(badarg)
end.
-spec(from_external(ExternalSet, Type) -> AnySet when
@@ -208,33 +196,26 @@ is_type(_T) ->
Set :: a_set(),
Terms :: [term()]).
set(L) ->
- case catch usort(L) of
- {'EXIT', _} ->
- erlang:error(badarg, [L]);
- SL ->
- ?SET(SL, ?ATOM_TYPE)
+ try usort(L) of
+ SL -> ?SET(SL, ?ATOM_TYPE)
+ catch _:_ -> erlang:error(badarg)
end.
-spec(set(Terms, Type) -> Set when
Set :: a_set(),
Terms :: [term()],
Type :: type()).
-set(L, ?SET_OF(Type) = T) when ?IS_ATOM_TYPE(Type), Type =/= ?ANYTYPE ->
- case catch usort(L) of
- {'EXIT', _} ->
- erlang:error(badarg, [L, T]);
- SL ->
- ?SET(SL, Type)
+set(L, ?SET_OF(Type)) when ?IS_ATOM_TYPE(Type), Type =/= ?ANYTYPE ->
+ try usort(L) of
+ SL -> ?SET(SL, Type)
+ catch _:_ -> erlang:error(badarg)
end;
set(L, ?SET_OF(_) = T) ->
- case catch setify(L, T) of
- {'EXIT', _} ->
- erlang:error(badarg, [L, T]);
- Set ->
- Set
+ try setify(L, T)
+ catch _:_ -> erlang:error(badarg)
end;
-set(L, T) ->
- erlang:error(badarg, [L, T]).
+set(_, _) ->
+ erlang:error(badarg).
-spec(from_sets(ListOfSets) -> Set when
Set :: a_set(),
@@ -245,19 +226,19 @@ set(L, T) ->
from_sets(Ss) when is_list(Ss) ->
case set_of_sets(Ss, [], ?ANYTYPE) of
{error, Error} ->
- erlang:error(Error, [Ss]);
+ erlang:error(Error);
Set ->
Set
end;
from_sets(Tuple) when is_tuple(Tuple) ->
case ordset_of_sets(tuple_to_list(Tuple), [], []) of
error ->
- erlang:error(badarg, [Tuple]);
+ erlang:error(badarg);
Set ->
Set
end;
-from_sets(T) ->
- erlang:error(badarg, [T]).
+from_sets(_) ->
+ erlang:error(badarg).
-spec(relation(Tuples) -> Relation when
Relation :: relation(),
@@ -265,14 +246,11 @@ from_sets(T) ->
relation([]) ->
?SET([], ?BINREL(?ATOM_TYPE, ?ATOM_TYPE));
relation(Ts = [T | _]) when is_tuple(T) ->
- case catch rel(Ts, tuple_size(T)) of
- {'EXIT', _} ->
- erlang:error(badarg, [Ts]);
- Set ->
- Set
+ try rel(Ts, tuple_size(T))
+ catch _:_ -> erlang:error(badarg)
end;
-relation(E) ->
- erlang:error(badarg, [E]).
+relation(_) ->
+ erlang:error(badarg).
-spec(relation(Tuples, Type) -> Relation when
N :: integer(),
@@ -280,24 +258,20 @@ relation(E) ->
Relation :: relation(),
Tuples :: [tuple()]).
relation(Ts, TS) ->
- case catch rel(Ts, TS) of
- {'EXIT', _} ->
- erlang:error(badarg, [Ts, TS]);
- Set ->
- Set
+ try rel(Ts, TS)
+ catch _:_ -> erlang:error(badarg)
end.
-spec(a_function(Tuples) -> Function when
Function :: a_function(),
Tuples :: [tuple()]).
a_function(Ts) ->
- case catch func(Ts, ?BINREL(?ATOM_TYPE, ?ATOM_TYPE)) of
- {'EXIT', _} ->
- erlang:error(badarg, [Ts]);
+ try func(Ts, ?BINREL(?ATOM_TYPE, ?ATOM_TYPE)) of
Bad when is_atom(Bad) ->
- erlang:error(Bad, [Ts]);
- Set ->
- Set
+ erlang:error(Bad);
+ Set ->
+ Set
+ catch _:_ -> erlang:error(badarg)
end.
-spec(a_function(Tuples, Type) -> Function when
@@ -305,26 +279,24 @@ a_function(Ts) ->
Tuples :: [tuple()],
Type :: type()).
a_function(Ts, T) ->
- case catch a_func(Ts, T) of
- {'EXIT', _} ->
- erlang:error(badarg, [Ts, T]);
+ try a_func(Ts, T) of
Bad when is_atom(Bad) ->
- erlang:error(Bad, [Ts, T]);
+ erlang:error(Bad);
Set ->
Set
+ catch _:_ -> erlang:error(badarg)
end.
-spec(family(Tuples) -> Family when
Family :: family(),
Tuples :: [tuple()]).
family(Ts) ->
- case catch fam2(Ts, ?FAMILY(?ATOM_TYPE, ?ATOM_TYPE)) of
- {'EXIT', _} ->
- erlang:error(badarg, [Ts]);
+ try fam2(Ts, ?FAMILY(?ATOM_TYPE, ?ATOM_TYPE)) of
Bad when is_atom(Bad) ->
- erlang:error(Bad, [Ts]);
+ erlang:error(Bad);
Set ->
Set
+ catch _:_ -> erlang:error(badarg)
end.
-spec(family(Tuples, Type) -> Family when
@@ -332,13 +304,12 @@ family(Ts) ->
Tuples :: [tuple()],
Type :: type()).
family(Ts, T) ->
- case catch fam(Ts, T) of
- {'EXIT', _} ->
- erlang:error(badarg, [Ts, T]);
+ try fam(Ts, T) of
Bad when is_atom(Bad) ->
- erlang:error(Bad, [Ts, T]);
+ erlang:error(Bad);
Set ->
Set
+ catch _:_ -> erlang:error(badarg)
end.
%%%
@@ -373,7 +344,7 @@ to_sets(S) when ?IS_SET(S) ->
to_sets(S) when ?IS_ORDSET(S), is_tuple(?ORDTYPE(S)) ->
tuple_of_sets(tuple_to_list(?ORDDATA(S)), tuple_to_list(?ORDTYPE(S)), []);
to_sets(S) when ?IS_ORDSET(S) ->
- erlang:error(badarg, [S]).
+ erlang:error(badarg).
-spec(no_elements(ASet) -> NoElements when
ASet :: a_set() | ordset(),
@@ -383,7 +354,7 @@ no_elements(S) when ?IS_SET(S) ->
no_elements(S) when ?IS_ORDSET(S), is_tuple(?ORDTYPE(S)) ->
tuple_size(?ORDDATA(S));
no_elements(S) when ?IS_ORDSET(S) ->
- erlang:error(badarg, [S]).
+ erlang:error(badarg).
-spec(specification(Fun, Set1) -> Set2 when
Fun :: spec_fun(),
@@ -401,7 +372,7 @@ specification(Fun, S) when ?IS_SET(S) ->
SL when is_list(SL) ->
?SET(SL, Type);
Bad ->
- erlang:error(Bad, [Fun, S])
+ erlang:error(Bad)
end.
-spec(union(Set1, Set2) -> Set3 when
@@ -410,7 +381,7 @@ specification(Fun, S) when ?IS_SET(S) ->
Set3 :: a_set()).
union(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
case unify_types(?TYPE(S1), ?TYPE(S2)) of
- [] -> erlang:error(type_mismatch, [S1, S2]);
+ [] -> erlang:error(type_mismatch);
Type -> ?SET(umerge(?LIST(S1), ?LIST(S2)), Type)
end.
@@ -420,7 +391,7 @@ union(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
Set3 :: a_set()).
intersection(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
case unify_types(?TYPE(S1), ?TYPE(S2)) of
- [] -> erlang:error(type_mismatch, [S1, S2]);
+ [] -> erlang:error(type_mismatch);
Type -> ?SET(intersection(?LIST(S1), ?LIST(S2), []), Type)
end.
@@ -430,7 +401,7 @@ intersection(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
Set3 :: a_set()).
difference(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
case unify_types(?TYPE(S1), ?TYPE(S2)) of
- [] -> erlang:error(type_mismatch, [S1, S2]);
+ [] -> erlang:error(type_mismatch);
Type -> ?SET(difference(?LIST(S1), ?LIST(S2), []), Type)
end.
@@ -440,7 +411,7 @@ difference(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
Set3 :: a_set()).
symdiff(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
case unify_types(?TYPE(S1), ?TYPE(S2)) of
- [] -> erlang:error(type_mismatch, [S1, S2]);
+ [] -> erlang:error(type_mismatch);
Type -> ?SET(symdiff(?LIST(S1), ?LIST(S2), []), Type)
end.
@@ -452,7 +423,7 @@ symdiff(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
Set5 :: a_set()).
symmetric_partition(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
case unify_types(?TYPE(S1), ?TYPE(S2)) of
- [] -> erlang:error(type_mismatch, [S1, S2]);
+ [] -> erlang:error(type_mismatch);
Type -> sympart(?LIST(S1), ?LIST(S2), [], [], [], Type)
end.
@@ -477,11 +448,9 @@ product({S1, S2}) ->
product(S1, S2);
product(T) when is_tuple(T) ->
Ss = tuple_to_list(T),
- case catch sets_to_list(Ss) of
- {'EXIT', _} ->
- erlang:error(badarg, [T]);
+ try sets_to_list(Ss) of
[] ->
- erlang:error(badarg, [T]);
+ erlang:error(badarg);
L ->
Type = types(Ss, []),
case member([], L) of
@@ -490,6 +459,7 @@ product(T) when is_tuple(T) ->
false ->
?SET(reverse(prod(L, [], [])), Type)
end
+ catch _:_ -> erlang:error(badarg)
end.
-spec(constant_function(Set, AnySet) -> Function when
@@ -502,10 +472,10 @@ constant_function(S, E) when ?IS_SET(S) ->
{Type, true} ->
NType = ?BINREL(Type, type(E)),
?SET(constant_function(?LIST(S), to_external(E), []), NType);
- _ -> erlang:error(badarg, [S, E])
+ _ -> erlang:error(badarg)
end;
-constant_function(S, E) when ?IS_ORDSET(S) ->
- erlang:error(badarg, [S, E]).
+constant_function(S, _) when ?IS_ORDSET(S) ->
+ erlang:error(badarg).
-spec(is_equal(AnySet1, AnySet2) -> Bool when
AnySet1 :: anyset(),
@@ -514,17 +484,17 @@ constant_function(S, E) when ?IS_ORDSET(S) ->
is_equal(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
case match_types(?TYPE(S1), ?TYPE(S2)) of
true -> ?LIST(S1) == ?LIST(S2);
- false -> erlang:error(type_mismatch, [S1, S2])
+ false -> erlang:error(type_mismatch)
end;
is_equal(S1, S2) when ?IS_ORDSET(S1), ?IS_ORDSET(S2) ->
case match_types(?ORDTYPE(S1), ?ORDTYPE(S2)) of
true -> ?ORDDATA(S1) == ?ORDDATA(S2);
- false -> erlang:error(type_mismatch, [S1, S2])
+ false -> erlang:error(type_mismatch)
end;
is_equal(S1, S2) when ?IS_SET(S1), ?IS_ORDSET(S2) ->
- erlang:error(type_mismatch, [S1, S2]);
+ erlang:error(type_mismatch);
is_equal(S1, S2) when ?IS_ORDSET(S1), ?IS_SET(S2) ->
- erlang:error(type_mismatch, [S1, S2]).
+ erlang:error(type_mismatch).
-spec(is_subset(Set1, Set2) -> Bool when
Bool :: boolean(),
@@ -533,7 +503,7 @@ is_equal(S1, S2) when ?IS_ORDSET(S1), ?IS_SET(S2) ->
is_subset(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
case match_types(?TYPE(S1), ?TYPE(S2)) of
true -> subset(?LIST(S1), ?LIST(S2));
- false -> erlang:error(type_mismatch, [S1, S2])
+ false -> erlang:error(type_mismatch)
end.
-spec(is_sofs_set(Term) -> Bool when
@@ -573,7 +543,7 @@ is_disjoint(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
[] -> true;
[A | As] -> disjoint(?LIST(S2), A, As)
end;
- false -> erlang:error(type_mismatch, [S1, S2])
+ false -> erlang:error(type_mismatch)
end.
%%%
@@ -587,7 +557,7 @@ union(Sets) when ?IS_SET(Sets) ->
case ?TYPE(Sets) of
?SET_OF(Type) -> ?SET(lunion(?LIST(Sets)), Type);
?ANYTYPE -> Sets;
- _ -> erlang:error(badarg, [Sets])
+ _ -> erlang:error(badarg)
end.
-spec(intersection(SetOfSets) -> Set when
@@ -595,12 +565,12 @@ union(Sets) when ?IS_SET(Sets) ->
SetOfSets :: set_of_sets()).
intersection(Sets) when ?IS_SET(Sets) ->
case ?LIST(Sets) of
- [] -> erlang:error(badarg, [Sets]);
+ [] -> erlang:error(badarg);
[L | Ls] ->
case ?TYPE(Sets) of
?SET_OF(Type) ->
?SET(lintersection(Ls, L), Type);
- _ -> erlang:error(badarg, [Sets])
+ _ -> erlang:error(badarg)
end
end.
@@ -614,7 +584,7 @@ canonical_relation(Sets) when ?IS_SET(Sets) ->
?SET_OF(Type) ->
?SET(can_rel(?LIST(Sets), []), ?BINREL(Type, ST));
?ANYTYPE -> Sets;
- _ -> erlang:error(badarg, [Sets])
+ _ -> erlang:error(badarg)
end.
%%%
@@ -636,7 +606,7 @@ relation_to_family(R) when ?IS_SET(R) ->
?BINREL(DT, RT) ->
?SET(rel2family(?LIST(R)), ?FAMILY(DT, RT));
?ANYTYPE -> R;
- _Else -> erlang:error(badarg, [R])
+ _Else -> erlang:error(badarg)
end.
-spec(domain(BinRel) -> Set when
@@ -646,7 +616,7 @@ domain(R) when ?IS_SET(R) ->
case ?TYPE(R) of
?BINREL(DT, _) -> ?SET(dom(?LIST(R)), DT);
?ANYTYPE -> R;
- _Else -> erlang:error(badarg, [R])
+ _Else -> erlang:error(badarg)
end.
-spec(range(BinRel) -> Set when
@@ -656,7 +626,7 @@ range(R) when ?IS_SET(R) ->
case ?TYPE(R) of
?BINREL(_, RT) -> ?SET(ran(?LIST(R), []), RT);
?ANYTYPE -> R;
- _ -> erlang:error(badarg, [R])
+ _ -> erlang:error(badarg)
end.
-spec(field(BinRel) -> Set when
@@ -679,7 +649,7 @@ relative_product(RT) when is_tuple(RT) ->
relative_product(RL) when is_list(RL) ->
case relprod_n(RL, foo, false, false) of
{error, Reason} ->
- erlang:error(Reason, [RL]);
+ erlang:error(Reason);
Reply ->
Reply
end.
@@ -703,11 +673,11 @@ relative_product(RL, R) when is_list(RL), ?IS_SET(R) ->
EmptyR = case ?TYPE(R) of
?BINREL(_, _) -> ?LIST(R) =:= [];
?ANYTYPE -> true;
- _ -> erlang:error(badarg, [RL, R])
+ _ -> erlang:error(badarg)
end,
case relprod_n(RL, R, EmptyR, true) of
{error, Reason} ->
- erlang:error(Reason, [RL, R]);
+ erlang:error(Reason);
Reply ->
Reply
end.
@@ -720,18 +690,18 @@ relative_product1(R1, R2) when ?IS_SET(R1), ?IS_SET(R2) ->
{DTR1, RTR1} = case ?TYPE(R1) of
?BINREL(_, _) = R1T -> R1T;
?ANYTYPE -> {?ANYTYPE, ?ANYTYPE};
- _ -> erlang:error(badarg, [R1, R2])
+ _ -> erlang:error(badarg)
end,
{DTR2, RTR2} = case ?TYPE(R2) of
?BINREL(_, _) = R2T -> R2T;
?ANYTYPE -> {?ANYTYPE, ?ANYTYPE};
- _ -> erlang:error(badarg, [R1, R2])
+ _ -> erlang:error(badarg)
end,
case match_types(DTR1, DTR2) of
true when DTR1 =:= ?ANYTYPE -> R1;
true when DTR2 =:= ?ANYTYPE -> R2;
true -> ?SET(relprod(?LIST(R1), ?LIST(R2)), ?BINREL(RTR1, RTR2));
- false -> erlang:error(type_mismatch, [R1, R2])
+ false -> erlang:error(type_mismatch)
end.
-spec(converse(BinRel1) -> BinRel2 when
@@ -741,7 +711,7 @@ converse(R) when ?IS_SET(R) ->
case ?TYPE(R) of
?BINREL(DT, RT) -> ?SET(converse(?LIST(R), []), ?BINREL(RT, DT));
?ANYTYPE -> R;
- _ -> erlang:error(badarg, [R])
+ _ -> erlang:error(badarg)
end.
-spec(image(BinRel, Set1) -> Set2 when
@@ -755,10 +725,10 @@ image(R, S) when ?IS_SET(R), ?IS_SET(S) ->
true ->
?SET(usort(restrict(?LIST(S), ?LIST(R))), RT);
false ->
- erlang:error(type_mismatch, [R, S])
+ erlang:error(type_mismatch)
end;
?ANYTYPE -> R;
- _ -> erlang:error(badarg, [R, S])
+ _ -> erlang:error(badarg)
end.
-spec(inverse_image(BinRel, Set1) -> Set2 when
@@ -773,10 +743,10 @@ inverse_image(R, S) when ?IS_SET(R), ?IS_SET(S) ->
NL = restrict(?LIST(S), converse(?LIST(R), [])),
?SET(usort(NL), DT);
false ->
- erlang:error(type_mismatch, [R, S])
+ erlang:error(type_mismatch)
end;
?ANYTYPE -> R;
- _ -> erlang:error(badarg, [R, S])
+ _ -> erlang:error(badarg)
end.
-spec(strict_relation(BinRel1) -> BinRel2 when
@@ -787,7 +757,7 @@ strict_relation(R) when ?IS_SET(R) ->
Type = ?BINREL(_, _) ->
?SET(strict(?LIST(R), []), Type);
?ANYTYPE -> R;
- _ -> erlang:error(badarg, [R])
+ _ -> erlang:error(badarg)
end.
-spec(weak_relation(BinRel1) -> BinRel2 when
@@ -798,12 +768,12 @@ weak_relation(R) when ?IS_SET(R) ->
?BINREL(DT, RT) ->
case unify_types(DT, RT) of
[] ->
- erlang:error(badarg, [R]);
+ erlang:error(badarg);
Type ->
?SET(weak(?LIST(R)), ?BINREL(Type, Type))
end;
?ANYTYPE -> R;
- _ -> erlang:error(badarg, [R])
+ _ -> erlang:error(badarg)
end.
-spec(extension(BinRel1, Set, AnySet) -> BinRel2 when
@@ -816,7 +786,7 @@ extension(R, S, E) when ?IS_SET(R), ?IS_SET(S) ->
{T=?BINREL(DT, RT), ST, true} ->
case match_types(DT, ST) and match_types(RT, type(E)) of
false ->
- erlang:error(type_mismatch, [R, S, E]);
+ erlang:error(type_mismatch);
true ->
RL = ?LIST(R),
case extc([], ?LIST(S), to_external(E), RL) of
@@ -836,7 +806,7 @@ extension(R, S, E) when ?IS_SET(R), ?IS_SET(S) ->
?SET([], ?BINREL(ST, ET))
end;
{_, _, true} ->
- erlang:error(badarg, [R, S, E])
+ erlang:error(badarg)
end.
-spec(is_a_function(BinRel) -> Bool when
@@ -850,7 +820,7 @@ is_a_function(R) when ?IS_SET(R) ->
[{V,_} | Es] -> is_a_func(Es, V)
end;
?ANYTYPE -> true;
- _ -> erlang:error(badarg, [R])
+ _ -> erlang:error(badarg)
end.
-spec(restriction(BinRel1, Set) -> BinRel2 when
@@ -879,12 +849,12 @@ composite(Fn1, Fn2) when ?IS_SET(Fn1), ?IS_SET(Fn2) ->
?BINREL(DTF1, RTF1) = case ?TYPE(Fn1)of
?BINREL(_, _) = F1T -> F1T;
?ANYTYPE -> {?ANYTYPE, ?ANYTYPE};
- _ -> erlang:error(badarg, [Fn1, Fn2])
+ _ -> erlang:error(badarg)
end,
?BINREL(DTF2, RTF2) = case ?TYPE(Fn2) of
?BINREL(_, _) = F2T -> F2T;
?ANYTYPE -> {?ANYTYPE, ?ANYTYPE};
- _ -> erlang:error(badarg, [Fn1, Fn2])
+ _ -> erlang:error(badarg)
end,
case match_types(RTF1, DTF2) of
true when DTF1 =:= ?ANYTYPE -> Fn1;
@@ -894,9 +864,9 @@ composite(Fn1, Fn2) when ?IS_SET(Fn1), ?IS_SET(Fn2) ->
SL when is_list(SL) ->
?SET(sort(SL), ?BINREL(DTF1, RTF2));
Bad ->
- erlang:error(Bad, [Fn1, Fn2])
+ erlang:error(Bad)
end;
- false -> erlang:error(type_mismatch, [Fn1, Fn2])
+ false -> erlang:error(type_mismatch)
end.
-spec(inverse(Function1) -> Function2 when
@@ -909,10 +879,10 @@ inverse(Fn) when ?IS_SET(Fn) ->
SL when is_list(SL) ->
?SET(SL, ?BINREL(RT, DT));
Bad ->
- erlang:error(Bad, [Fn])
+ erlang:error(Bad)
end;
?ANYTYPE -> Fn;
- _ -> erlang:error(badarg, [Fn])
+ _ -> erlang:error(badarg)
end.
%%%
@@ -932,7 +902,7 @@ restriction(I, R, S) when is_integer(I), ?IS_SET(R), ?IS_SET(S) ->
empty ->
R;
error ->
- erlang:error(badarg, [I, R, S]);
+ erlang:error(badarg);
Sort ->
RL = ?LIST(R),
case {match_types(?REL_TYPE(I, RT), ST), ?LIST(S)} of
@@ -945,7 +915,7 @@ restriction(I, R, S) when is_integer(I), ?IS_SET(R), ?IS_SET(S) ->
{true, [E | Es]} ->
?SET(sort(restrict_n(I, keysort(I, RL), E, Es, [])), RT);
{false, _SL} ->
- erlang:error(type_mismatch, [I, R, S])
+ erlang:error(type_mismatch)
end
end;
restriction(SetFun, S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
@@ -963,28 +933,27 @@ restriction(SetFun, S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
NL = sort(restrict(?LIST(S2), converse(NSL, []))),
?SET(NL, Type1);
false ->
- erlang:error(type_mismatch, [SetFun, S1, S2])
+ erlang:error(type_mismatch)
end;
Bad ->
- erlang:error(Bad, [SetFun, S1, S2])
+ erlang:error(Bad)
end;
_ when Type1 =:= ?ANYTYPE ->
S1;
_XFun when ?IS_SET_OF(Type1) ->
- erlang:error(badarg, [SetFun, S1, S2]);
+ erlang:error(badarg);
XFun ->
FunT = XFun(Type1),
- case catch check_fun(Type1, XFun, FunT) of
- {'EXIT', _} ->
- erlang:error(badarg, [SetFun, S1, S2]);
+ try check_fun(Type1, XFun, FunT) of
Sort ->
case match_types(FunT, Type2) of
true ->
R1 = inverse_substitution(SL1, XFun, Sort),
?SET(sort(Sort, restrict(?LIST(S2), R1)), Type1);
false ->
- erlang:error(type_mismatch, [SetFun, S1, S2])
+ erlang:error(type_mismatch)
end
+ catch _:_ -> erlang:error(badarg)
end
end.
@@ -1000,7 +969,7 @@ drestriction(I, R, S) when is_integer(I), ?IS_SET(R), ?IS_SET(S) ->
empty ->
R;
error ->
- erlang:error(badarg, [I, R, S]);
+ erlang:error(badarg);
Sort ->
RL = ?LIST(R),
case {match_types(?REL_TYPE(I, RT), ST), ?LIST(S)} of
@@ -1013,7 +982,7 @@ drestriction(I, R, S) when is_integer(I), ?IS_SET(R), ?IS_SET(S) ->
{true, [E | Es]} ->
?SET(diff_restrict_n(I, keysort(I, RL), E, Es, []), RT);
{false, _SL} ->
- erlang:error(type_mismatch, [I, R, S])
+ erlang:error(type_mismatch)
end
end;
drestriction(SetFun, S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
@@ -1032,20 +1001,18 @@ drestriction(SetFun, S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
NL = sort(diff_restrict(SL2, converse(NSL, []))),
?SET(NL, Type1);
false ->
- erlang:error(type_mismatch, [SetFun, S1, S2])
+ erlang:error(type_mismatch)
end;
Bad ->
- erlang:error(Bad, [SetFun, S1, S2])
+ erlang:error(Bad)
end;
_ when Type1 =:= ?ANYTYPE ->
S1;
_XFun when ?IS_SET_OF(Type1) ->
- erlang:error(badarg, [SetFun, S1, S2]);
+ erlang:error(badarg);
XFun ->
FunT = XFun(Type1),
- case catch check_fun(Type1, XFun, FunT) of
- {'EXIT', _} ->
- erlang:error(badarg, [SetFun, S1, S2]);
+ try check_fun(Type1, XFun, FunT) of
Sort ->
case match_types(FunT, Type2) of
true ->
@@ -1053,8 +1020,9 @@ drestriction(SetFun, S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
SL2 = ?LIST(S2),
?SET(sort(Sort, diff_restrict(SL2, R1)), Type1);
false ->
- erlang:error(type_mismatch, [SetFun, S1, S2])
+ erlang:error(type_mismatch)
end
+ catch _:_ -> erlang:error(badarg)
end
end.
@@ -1068,7 +1036,7 @@ projection(I, Set) when is_integer(I), ?IS_SET(Set) ->
empty ->
Set;
error ->
- erlang:error(badarg, [I, Set]);
+ erlang:error(badarg);
_ when I =:= 1 ->
?SET(projection1(?LIST(Set)), ?REL_TYPE(I, Type));
_ ->
@@ -1087,7 +1055,7 @@ substitution(I, Set) when is_integer(I), ?IS_SET(Set) ->
empty ->
Set;
error ->
- erlang:error(badarg, [I, Set]);
+ erlang:error(badarg);
_Sort ->
NType = ?REL_TYPE(I, Type),
NSL = substitute_element(?LIST(Set), I, []),
@@ -1102,22 +1070,21 @@ substitution(SetFun, Set) when ?IS_SET(Set) ->
{SL, NewType} ->
?SET(reverse(SL), ?BINREL(Type, NewType));
Bad ->
- erlang:error(Bad, [SetFun, Set])
+ erlang:error(Bad)
end;
false ->
empty_set();
_ when Type =:= ?ANYTYPE ->
empty_set();
_XFun when ?IS_SET_OF(Type) ->
- erlang:error(badarg, [SetFun, Set]);
+ erlang:error(badarg);
XFun ->
FunT = XFun(Type),
- case catch check_fun(Type, XFun, FunT) of
- {'EXIT', _} ->
- erlang:error(badarg, [SetFun, Set]);
+ try check_fun(Type, XFun, FunT) of
_Sort ->
SL = substitute(L, XFun, []),
?SET(SL, ?BINREL(Type, FunT))
+ catch _:_ -> erlang:error(badarg)
end
end.
@@ -1139,7 +1106,7 @@ partition(I, Set) when is_integer(I), ?IS_SET(Set) ->
empty ->
Set;
error ->
- erlang:error(badarg, [I, Set]);
+ erlang:error(badarg);
false -> % I =:= 1
?SET(partition_n(I, ?LIST(Set)), ?SET_OF(Type));
true ->
@@ -1161,7 +1128,7 @@ partition(I, R, S) when is_integer(I), ?IS_SET(R), ?IS_SET(S) ->
empty ->
{R, R};
error ->
- erlang:error(badarg, [I, R, S]);
+ erlang:error(badarg);
Sort ->
RL = ?LIST(R),
case {match_types(?REL_TYPE(I, RT), ST), ?LIST(S)} of
@@ -1176,7 +1143,7 @@ partition(I, R, S) when is_integer(I), ?IS_SET(R), ?IS_SET(S) ->
[L1 | L2] = partition3_n(I, keysort(I,RL), E, Es, [], []),
{?SET(L1, RT), ?SET(L2, RT)};
{false, _SL} ->
- erlang:error(type_mismatch, [I, R, S])
+ erlang:error(type_mismatch)
end
end;
partition(SetFun, S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
@@ -1195,20 +1162,18 @@ partition(SetFun, S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
[L1 | L2] = partition3(?LIST(S2), R1),
{?SET(sort(L1), Type1), ?SET(sort(L2), Type1)};
false ->
- erlang:error(type_mismatch, [SetFun, S1, S2])
+ erlang:error(type_mismatch)
end;
Bad ->
- erlang:error(Bad, [SetFun, S1, S2])
+ erlang:error(Bad)
end;
_ when Type1 =:= ?ANYTYPE ->
{S1, S1};
_XFun when ?IS_SET_OF(Type1) ->
- erlang:error(badarg, [SetFun, S1, S2]);
+ erlang:error(badarg);
XFun ->
FunT = XFun(Type1),
- case catch check_fun(Type1, XFun, FunT) of
- {'EXIT', _} ->
- erlang:error(badarg, [SetFun, S1, S2]);
+ try check_fun(Type1, XFun, FunT) of
Sort ->
case match_types(FunT, Type2) of
true ->
@@ -1216,8 +1181,9 @@ partition(SetFun, S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
[L1 | L2] = partition3(?LIST(S2), R1),
{?SET(sort(L1), Type1), ?SET(sort(L2), Type1)};
false ->
- erlang:error(type_mismatch, [SetFun, S1, S2])
+ erlang:error(type_mismatch)
end
+ catch _:_ -> erlang:error(badarg)
end
end.
@@ -1234,7 +1200,7 @@ multiple_relative_product(T, R) when is_tuple(T), ?IS_SET(R) ->
MProd = mul_relprod(tuple_to_list(T), 1, R),
relative_product(MProd);
false ->
- erlang:error(badarg, [T, R])
+ erlang:error(badarg)
end.
-spec(join(Relation1, I, Relation2, J) -> Relation3 when
@@ -1246,8 +1212,7 @@ multiple_relative_product(T, R) when is_tuple(T), ?IS_SET(R) ->
join(R1, I1, R2, I2)
when ?IS_SET(R1), ?IS_SET(R2), is_integer(I1), is_integer(I2) ->
case test_rel(R1, I1, lte) and test_rel(R2, I2, lte) of
- false ->
- erlang:error(badarg, [R1, I1, R2, I2]);
+ false -> erlang:error(badarg);
true when ?TYPE(R1) =:= ?ANYTYPE -> R1;
true when ?TYPE(R2) =:= ?ANYTYPE -> R2;
true ->
@@ -1294,7 +1259,7 @@ family_to_relation(F) when ?IS_SET(F) ->
?FAMILY(DT, RT) ->
?SET(family2rel(?LIST(F), []), ?BINREL(DT, RT));
?ANYTYPE -> F;
- _ -> erlang:error(badarg, [F])
+ _ -> erlang:error(badarg)
end.
-spec(family_specification(Fun, Family1) -> Family2 when
@@ -1314,10 +1279,10 @@ family_specification(Fun, F) when ?IS_SET(F) ->
SL when is_list(SL) ->
?SET(SL, FType);
Bad ->
- erlang:error(Bad, [Fun, F])
+ erlang:error(Bad)
end;
?ANYTYPE -> F;
- _ -> erlang:error(badarg, [Fun, F])
+ _ -> erlang:error(badarg)
end.
-spec(union_of_family(Family) -> Set when
@@ -1328,7 +1293,7 @@ union_of_family(F) when ?IS_SET(F) ->
?FAMILY(_DT, Type) ->
?SET(un_of_fam(?LIST(F), []), Type);
?ANYTYPE -> F;
- _ -> erlang:error(badarg, [F])
+ _ -> erlang:error(badarg)
end.
-spec(intersection_of_family(Family) -> Set when
@@ -1341,9 +1306,9 @@ intersection_of_family(F) when ?IS_SET(F) ->
FU when is_list(FU) ->
?SET(FU, Type);
Bad ->
- erlang:error(Bad, [F])
+ erlang:error(Bad)
end;
- _ -> erlang:error(badarg, [F])
+ _ -> erlang:error(badarg)
end.
-spec(family_union(Family1) -> Family2 when
@@ -1354,7 +1319,7 @@ family_union(F) when ?IS_SET(F) ->
?FAMILY(DT, ?SET_OF(Type)) ->
?SET(fam_un(?LIST(F), []), ?FAMILY(DT, Type));
?ANYTYPE -> F;
- _ -> erlang:error(badarg, [F])
+ _ -> erlang:error(badarg)
end.
-spec(family_intersection(Family1) -> Family2 when
@@ -1367,10 +1332,10 @@ family_intersection(F) when ?IS_SET(F) ->
FU when is_list(FU) ->
?SET(FU, ?FAMILY(DT, Type));
Bad ->
- erlang:error(Bad, [F])
+ erlang:error(Bad)
end;
?ANYTYPE -> F;
- _ -> erlang:error(badarg, [F])
+ _ -> erlang:error(badarg)
end.
-spec(family_domain(Family1) -> Family2 when
@@ -1382,7 +1347,7 @@ family_domain(F) when ?IS_SET(F) ->
?SET(fam_dom(?LIST(F), []), ?FAMILY(FDT, DT));
?ANYTYPE -> F;
?FAMILY(_, ?ANYTYPE) -> F;
- _ -> erlang:error(badarg, [F])
+ _ -> erlang:error(badarg)
end.
-spec(family_range(Family1) -> Family2 when
@@ -1394,7 +1359,7 @@ family_range(F) when ?IS_SET(F) ->
?SET(fam_ran(?LIST(F), []), ?FAMILY(DT, RT));
?ANYTYPE -> F;
?FAMILY(_, ?ANYTYPE) -> F;
- _ -> erlang:error(badarg, [F])
+ _ -> erlang:error(badarg)
end.
-spec(family_field(Family1) -> Family2 when
@@ -1428,12 +1393,12 @@ family_difference(F1, F2) ->
fam_binop(F1, F2, FF) when ?IS_SET(F1), ?IS_SET(F2) ->
case unify_types(?TYPE(F1), ?TYPE(F2)) of
[] ->
- erlang:error(type_mismatch, [F1, F2]);
+ erlang:error(type_mismatch);
?ANYTYPE ->
F1;
Type = ?FAMILY(_, _) ->
?SET(FF(?LIST(F1), ?LIST(F2), []), Type);
- _ -> erlang:error(badarg, [F1, F2])
+ _ -> erlang:error(badarg)
end.
-spec(partition_family(SetFun, Set) -> Family when
@@ -1446,7 +1411,7 @@ partition_family(I, Set) when is_integer(I), ?IS_SET(Set) ->
empty ->
Set;
error ->
- erlang:error(badarg, [I, Set]);
+ erlang:error(badarg);
false -> % when I =:= 1
?SET(fam_partition_n(I, ?LIST(Set)),
?BINREL(?REL_TYPE(I, Type), ?SET_OF(Type)));
@@ -1464,23 +1429,22 @@ partition_family(SetFun, Set) when ?IS_SET(Set) ->
P = fam_partition(converse(NSL, []), true),
?SET(reverse(P), ?BINREL(NewType, ?SET_OF(Type)));
Bad ->
- erlang:error(Bad, [SetFun, Set])
+ erlang:error(Bad)
end;
false ->
empty_set();
_ when Type =:= ?ANYTYPE ->
empty_set();
_XFun when ?IS_SET_OF(Type) ->
- erlang:error(badarg, [SetFun, Set]);
+ erlang:error(badarg);
XFun ->
DType = XFun(Type),
- case catch check_fun(Type, XFun, DType) of
- {'EXIT', _} ->
- erlang:error(badarg, [SetFun, Set]);
+ try check_fun(Type, XFun, DType) of
Sort ->
Ts = inverse_substitution(?LIST(Set), XFun, Sort),
P = fam_partition(Ts, Sort),
?SET(reverse(P), ?BINREL(DType, ?SET_OF(Type)))
+ catch _:_ -> erlang:error(badarg)
end
end.
@@ -1499,13 +1463,13 @@ family_projection(SetFun, F) when ?IS_SET(F) ->
{SL, NewType} ->
?SET(SL, ?BINREL(DT, NewType));
Bad ->
- erlang:error(Bad, [SetFun, F])
+ erlang:error(Bad)
end;
_ ->
- erlang:error(badarg, [SetFun, F])
+ erlang:error(badarg)
end;
?ANYTYPE -> F;
- _ -> erlang:error(badarg, [SetFun, F])
+ _ -> erlang:error(badarg)
end.
%%%
@@ -1519,7 +1483,7 @@ family_to_digraph(F) when ?IS_SET(F) ->
case ?TYPE(F) of
?FAMILY(_, _) -> fam2digraph(F, digraph:new());
?ANYTYPE -> digraph:new();
- _Else -> erlang:error(badarg, [F])
+ _Else -> erlang:error(badarg)
end.
-spec(family_to_digraph(Family, GraphType) -> Graph when
@@ -1530,27 +1494,27 @@ family_to_digraph(F, Type) when ?IS_SET(F) ->
case ?TYPE(F) of
?FAMILY(_, _) -> ok;
?ANYTYPE -> ok;
- _Else -> erlang:error(badarg, [F, Type])
+ _Else -> erlang:error(badarg)
end,
try digraph:new(Type) of
G -> case catch fam2digraph(F, G) of
{error, Reason} ->
true = digraph:delete(G),
- erlang:error(Reason, [F, Type]);
+ erlang:error(Reason);
_ ->
G
end
catch
- error:badarg -> erlang:error(badarg, [F, Type])
+ error:badarg -> erlang:error(badarg)
end.
-spec(digraph_to_family(Graph) -> Family when
Graph :: digraph:graph(),
Family :: family()).
digraph_to_family(G) ->
- case catch digraph_family(G) of
- {'EXIT', _} -> erlang:error(badarg, [G]);
+ try digraph_family(G) of
L -> ?SET(L, ?FAMILY(?ATOM_TYPE, ?ATOM_TYPE))
+ catch _:_ -> erlang:error(badarg)
end.
-spec(digraph_to_family(Graph, Type) -> Family when
@@ -1560,12 +1524,12 @@ digraph_to_family(G) ->
digraph_to_family(G, T) ->
case {is_type(T), T} of
{true, ?SET_OF(?FAMILY(_,_) = Type)} ->
- case catch digraph_family(G) of
- {'EXIT', _} -> erlang:error(badarg, [G, T]);
+ try digraph_family(G) of
L -> ?SET(L, Type)
+ catch _:_ -> erlang:error(badarg)
end;
_ ->
- erlang:error(badarg, [G, T])
+ erlang:error(badarg)
end.
%%
@@ -1713,14 +1677,15 @@ func_type([], SL, Type, F) ->
setify(L, ?SET_OF(Atom)) when ?IS_ATOM_TYPE(Atom), Atom =/= ?ANYTYPE ->
?SET(usort(L), Atom);
setify(L, ?SET_OF(Type0)) ->
- case catch is_no_lists(Type0) of
- {'EXIT', _} ->
- {?SET_OF(Type), Set} = create(L, Type0, Type0, []),
- ?SET(Set, Type);
+ try is_no_lists(Type0) of
N when is_integer(N) ->
- rel(L, N, Type0);
+ rel(L, N, Type0);
Sizes ->
make_oset(L, Sizes, L, Type0)
+ catch
+ _:_ ->
+ {?SET_OF(Type), Set} = create(L, Type0, Type0, []),
+ ?SET(Set, Type)
end;
setify(E, Type0) ->
{Type, OrdSet} = make_element(E, Type0, Type0),
diff --git a/lib/stdlib/test/filename_SUITE.erl b/lib/stdlib/test/filename_SUITE.erl
index 54066021fb..dc3daa56c1 100644
--- a/lib/stdlib/test/filename_SUITE.erl
+++ b/lib/stdlib/test/filename_SUITE.erl
@@ -29,6 +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]).
-export([t_basedir_api/1, t_basedir_xdg/1, t_basedir_windows/1]).
+-export([safe_relative_path/1]).
-include_lib("common_test/include/ct.hrl").
@@ -41,7 +42,8 @@ all() ->
find_src,
absname_bin, absname_bin_2,
{group,p},
- t_basedir_xdg, t_basedir_windows].
+ t_basedir_xdg, t_basedir_windows,
+ safe_relative_path].
groups() ->
[{p, [parallel],
@@ -770,6 +772,71 @@ t_nativename_bin(Config) when is_list(Config) ->
filename:nativename(<<"/usr/tmp//arne/">>)
end.
+safe_relative_path(Config) ->
+ PrivDir = proplists:get_value(priv_dir, Config),
+ Root = filename:join(PrivDir, ?FUNCTION_NAME),
+ ok = file:make_dir(Root),
+ ok = file:set_cwd(Root),
+
+ ok = file:make_dir("a"),
+ ok = file:set_cwd("a"),
+ ok = file:make_dir("b"),
+ ok = file:set_cwd("b"),
+ ok = file:make_dir("c"),
+
+ ok = file:set_cwd(Root),
+
+ "a" = test_srp("a"),
+ "a/b" = test_srp("a/b"),
+ "a/b" = test_srp("a/./b"),
+ "a/b" = test_srp("a/./b/."),
+
+ "" = test_srp("a/.."),
+ "" = test_srp("a/./.."),
+ "" = test_srp("a/../."),
+ "a" = test_srp("a/b/.."),
+ "a" = test_srp("a/../a"),
+ "a" = test_srp("a/../a/../a"),
+ "a/b/c" = test_srp("a/../a/b/c"),
+
+ unsafe = test_srp("a/../.."),
+ unsafe = test_srp("a/../../.."),
+ unsafe = test_srp("a/./../.."),
+ unsafe = test_srp("a/././../../.."),
+ unsafe = test_srp("a/b/././../../.."),
+
+ unsafe = test_srp(PrivDir), %Absolute path.
+
+ ok.
+
+test_srp(RelPath) ->
+ Res = do_test_srp(RelPath),
+ Res = case do_test_srp(list_to_binary(RelPath)) of
+ Bin when is_binary(Bin) ->
+ binary_to_list(Bin);
+ Other ->
+ Other
+ end.
+
+do_test_srp(RelPath) ->
+ {ok,Root} = file:get_cwd(),
+ ok = file:set_cwd(RelPath),
+ {ok,Cwd} = file:get_cwd(),
+ ok = file:set_cwd(Root),
+ case filename:safe_relative_path(RelPath) of
+ unsafe ->
+ true = length(Cwd) < length(Root),
+ unsafe;
+ "" ->
+ "";
+ SafeRelPath ->
+ ok = file:set_cwd(SafeRelPath),
+ {ok,Cwd} = file:get_cwd(),
+ true = length(Cwd) >= length(Root),
+ ok = file:set_cwd(Root),
+ SafeRelPath
+ end.
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% basedirs
t_basedir_api(Config) when is_list(Config) ->
diff --git a/lib/stdlib/test/io_SUITE.erl b/lib/stdlib/test/io_SUITE.erl
index b0a1e461e3..d546e8fad2 100644
--- a/lib/stdlib/test/io_SUITE.erl
+++ b/lib/stdlib/test/io_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -30,7 +30,7 @@
io_lib_print_binary_depth_one/1, otp_10302/1, otp_10755/1,
otp_10836/1, io_lib_width_too_small/1,
io_with_huge_message_queue/1, format_string/1,
- maps/1, coverage/1, otp_14178_unicode_atoms/1]).
+ maps/1, coverage/1, otp_14178_unicode_atoms/1, otp_14175/1]).
-export([pretty/2]).
@@ -61,7 +61,7 @@ all() ->
printable_range, bad_printable_range,
io_lib_print_binary_depth_one, otp_10302, otp_10755, otp_10836,
io_lib_width_too_small, io_with_huge_message_queue,
- format_string, maps, coverage, otp_14178_unicode_atoms].
+ format_string, maps, coverage, otp_14178_unicode_atoms, otp_14175].
%% Error cases for output.
error_1(Config) when is_list(Config) ->
@@ -415,13 +415,13 @@ otp_6354(Config) when is_list(Config) ->
bt(<<"#rrrrr{\n"
" f1 = 1,\n"
" f2 = #rrrrr{f1 = a,f2 = b,f3 = c},\n"
- " f3 = \n"
+ " f3 =\n"
" #rrrrr{\n"
" f1 = h,f2 = i,\n"
- " f3 = \n"
+ " f3 =\n"
" #rrrrr{\n"
" f1 = aa,\n"
- " f2 = \n"
+ " f2 =\n"
" #rrrrr{\n"
" f1 = #rrrrr{f1 = a,f2 = b,f3 = c},\n"
" f2 = 2,f3 = 3},\n"
@@ -431,17 +431,17 @@ otp_6354(Config) when is_list(Config) ->
2,3},bb}}},
-1)),
bt(<<"#d{aaaaaaaaaaaaaaaaaaaa = 1,\n"
- " bbbbbbbbbbbbbbbbbbbb = \n"
+ " bbbbbbbbbbbbbbbbbbbb =\n"
" #d{aaaaaaaaaaaaaaaaaaaa = a,bbbbbbbbbbbbbbbbbbbb = b,\n"
" cccccccccccccccccccc = c,dddddddddddddddddddd = d,\n"
" eeeeeeeeeeeeeeeeeeee = e},\n"
" cccccccccccccccccccc = 3,\n"
- " dddddddddddddddddddd = \n"
+ " dddddddddddddddddddd =\n"
" #d{aaaaaaaaaaaaaaaaaaaa = h,bbbbbbbbbbbbbbbbbbbb = i,\n"
- " cccccccccccccccccccc = \n"
+ " cccccccccccccccccccc =\n"
" #d{aaaaaaaaaaaaaaaaaaaa = aa,"
"bbbbbbbbbbbbbbbbbbbb = bb,\n"
- " cccccccccccccccccccc = \n"
+ " cccccccccccccccccccc =\n"
" #d{aaaaaaaaaaaaaaaaaaaa = 1,"
"bbbbbbbbbbbbbbbbbbbb = 2,\n"
" cccccccccccccccccccc = 3,"
@@ -534,21 +534,21 @@ otp_6354(Config) when is_list(Config) ->
p({A,{A,{A,{A,{A,{A,{A,
{g,{h,{i,{j,{k,{l,{m,{n,{o,{a}}}}}}}}}}}}}}}}}, 100)),
bt(<<"#c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
" f1 = #c{f1 = #c{f1 = #c{f1 = a,"
"f2 = b},f2 = b},f2 = b},\n"
@@ -564,13 +564,13 @@ otp_6354(Config) when is_list(Config) ->
p({c,{c,{c,{c,{c,{c,{c,{c,{c,{c,{c,{c,a,b},b},b},b},b},b},
b},b},b},b},b},b}, -1)),
bt(<<"#rrrrr{\n"
- " f1 = \n"
+ " f1 =\n"
" #rrrrr{\n"
- " f1 = \n"
+ " f1 =\n"
" #rrrrr{\n"
- " f1 = \n"
+ " f1 =\n"
" #rrrrr{\n"
- " f1 = \n"
+ " f1 =\n"
" {rrrrr,{rrrrr,a,#rrrrr{f1 = {rrrrr,1,2},f2 = a,"
"f3 = b}},b},\n"
" f2 = {rrrrr,c,d},\n"
@@ -2127,3 +2127,200 @@ bad_io_lib_format(F, S) ->
error:badarg ->
ok
end.
+
+otp_14175(_Config) ->
+ "..." = p(#{}, 0),
+ "#{}" = p(#{}, 1),
+ "#{...}" = p(#{a => 1}, 1),
+ "#{#{} => a}" = p(#{#{} => a}, 2),
+ "#{a => 1,...}" = p(#{a => 1, b => 2}, 2),
+ "#{a => 1,b => 2}" = p(#{a => 1, b => 2}, -1),
+
+ M = #{kaaaaaaaaaaaaaaaaaaa => v1,kbbbbbbbbbbbbbbbbbbb => v2,
+ kccccccccccccccccccc => v3,kddddddddddddddddddd => v4,
+ keeeeeeeeeeeeeeeeeee => v5},
+ "#{...}" = p(M, 1),
+ mt("#{kaaaaaaaaaaaaaaaaaaaa => v1,...}", p(M, 2)),
+ mt("#{kaaaaaaaaaaaaaaaaaaaa => 1,kbbbbbbbbbbbbbbbbbbbb => 2,...}",
+ p(M, 3)),
+
+ mt("#{kaaaaaaaaaaaaaaaaaaa => v1,kbbbbbbbbbbbbbbbbbbb => v2,\n"
+ " kccccccccccccccccccc => v3,...}", p(M, 4)),
+
+ mt("#{kaaaaaaaaaaaaaaaaaaa => v1,kbbbbbbbbbbbbbbbbbbb => v2,\n"
+ " kccccccccccccccccccc => v3,kddddddddddddddddddd => v4,...}",
+ p(M, 5)),
+
+ mt("#{kaaaaaaaaaaaaaaaaaaa => v1,kbbbbbbbbbbbbbbbbbbb => v2,\n"
+ " kccccccccccccccccccc => v3,kddddddddddddddddddd => v4,\n"
+ " keeeeeeeeeeeeeeeeeee => v5}", p(M, 6)),
+
+ weak("#{aaaaaaaaaaaaaaaaaaa => 1,bbbbbbbbbbbbbbbbbbbb => 2,\n"
+ " cccccccccccccccccccc => {3},\n"
+ " dddddddddddddddddddd => 4,eeeeeeeeeeeeeeeeeeee => 5}",
+ p(#{aaaaaaaaaaaaaaaaaaa => 1,bbbbbbbbbbbbbbbbbbbb => 2,
+ cccccccccccccccccccc => {3},
+ dddddddddddddddddddd => 4,eeeeeeeeeeeeeeeeeeee => 5}, -1)),
+
+ M2 = #{dddddddddddddddddddd => {1}, {aaaaaaaaaaaaaaaaaaaa} => 2,
+ {bbbbbbbbbbbbbbbbbbbb} => 3,{cccccccccccccccccccc} => 4,
+ {eeeeeeeeeeeeeeeeeeee} => 5},
+ "#{...}" = p(M2, 1),
+ weak("#{dddddddddddddddddddd => {...},...}", p(M2, 2)),
+ weak("#{dddddddddddddddddddd => {1},{...} => 2,...}", p(M2, 3)),
+
+ weak("#{dddddddddddddddddddd => {1},\n"
+ " {aaaaaaaaaaaaaaaaaaaa} => 2,\n"
+ " {...} => 3,...}", p(M2, 4)),
+
+ weak("#{dddddddddddddddddddd => {1},\n"
+ " {aaaaaaaaaaaaaaaaaaaa} => 2,\n"
+ " {bbbbbbbbbbbbbbbbbbbb} => 3,\n"
+ " {...} => 4,...}", p(M2, 5)),
+
+ weak("#{dddddddddddddddddddd => {1},\n"
+ " {aaaaaaaaaaaaaaaaaaaa} => 2,\n"
+ " {bbbbbbbbbbbbbbbbbbbb} => 3,\n"
+ " {cccccccccccccccccccc} => 4,\n"
+ " {...} => 5}", p(M2, 6)),
+
+ weak("#{dddddddddddddddddddd => {1},\n"
+ " {aaaaaaaaaaaaaaaaaaaa} => 2,\n"
+ " {bbbbbbbbbbbbbbbbbbbb} => 3,\n"
+ " {cccccccccccccccccccc} => 4,\n"
+ " {eeeeeeeeeeeeeeeeeeee} => 5}", p(M2, 7)),
+
+ M3 = #{kaaaaaaaaaaaaaaaaaaa => vuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuu,
+ kbbbbbbbbbbbbbbbbbbb => vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv,
+ kccccccccccccccccccc => vxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx,
+ kddddddddddddddddddd => vyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy,
+ keeeeeeeeeeeeeeeeeee => vzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz},
+
+ mt("#{aaaaaaaaaaaaaaaaaaaa =>\n"
+ " uuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuu,\n"
+ " bbbbbbbbbbbbbbbbbbbb =>\n"
+ " vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv,\n"
+ " cccccccccccccccccccc =>\n"
+ " xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx,\n"
+ " dddddddddddddddddddd =>\n"
+ " yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy,\n"
+ " eeeeeeeeeeeeeeeeeeee =>\n"
+ " zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz}", p(M3, -1)),
+
+ R4 = {c,{c,{c,{c,{c,{c,{c,{c,{c,{c,{c,{c,a,b},b},b},b},b},b},
+ b},b},b},b},b},b},
+ M4 = #{aaaaaaaaaaaaaaaaaaaa => R4,
+ bbbbbbbbbbbbbbbbbbbb => R4,
+ cccccccccccccccccccc => R4,
+ dddddddddddddddddddd => R4,
+ eeeeeeeeeeeeeeeeeeee => R4},
+
+ weak("#{aaaaaaaaaaaaaaaaaaaa =>\n"
+ " #c{f1 = #c{f1 = #c{...},f2 = b},f2 = b},\n"
+ " bbbbbbbbbbbbbbbbbbbb => #c{f1 = #c{f1 = {...},...},f2 = b},\n"
+ " cccccccccccccccccccc => #c{f1 = #c{...},f2 = b},\n"
+ " dddddddddddddddddddd => #c{f1 = {...},...},\n"
+ " eeeeeeeeeeeeeeeeeeee => #c{...}}", p(M4, 7)),
+
+ M5 = #{aaaaaaaaaaaaaaaaaaaa => R4},
+ mt("#{aaaaaaaaaaaaaaaaaaaa =>\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 = #c{f1 = #c{f1 = #c{f1 = a,f2 = b},f2 = b},"
+ "f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b}}", p(M5, -1)),
+ ok.
+
+%% Just check number of newlines and dots ('...').
+-define(WEAK, true).
+
+-ifdef(WEAK).
+
+weak(S, R) ->
+ (nl(S) =:= nl(R) andalso
+ dots(S) =:= dots(S)).
+
+nl(S) ->
+ [C || C <- S, C =:= $\n].
+
+dots(S) ->
+ [C || C <- S, C =:= $\.].
+
+-else. % WEAK
+
+weak(S, R) ->
+ mt(S, R).
+
+-endif. % WEAK
+
+%% If EXACT is defined: mt() matches strings exactly.
+%%
+%% if EXACT is not defined: do not match the strings exactly, but
+%% compare them assuming that all map keys and all map values are
+%% equal (by assuming all map keys and all map values have the same
+%% length and begin with $k and $v respectively).
+
+%-define(EXACT, true).
+
+-ifdef(EXACT).
+
+mt(S, R) ->
+ S =:= R.
+
+-else. % EXACT
+
+mt(S, R) ->
+ anon(S) =:= anon(R).
+
+anon(S) ->
+ {ok, Ts0, _} = erl_scan:string(S, 1, [text]),
+ Ts = anon1(Ts0),
+ text(Ts).
+
+anon1([]) -> [];
+anon1([{atom,Anno,Atom}=T|Ts]) ->
+ case erl_anno:text(Anno) of
+ "k" ++ _ ->
+ NewAnno = erl_anno:set_text("key", Anno),
+ [{atom,NewAnno,Atom}|anon1(Ts)];
+ "v" ++ _ ->
+ NewAnno = erl_anno:set_text("val", Anno),
+ [{atom,NewAnno,Atom}|anon1(Ts)];
+ _ ->
+ [T|anon1(Ts)]
+ end;
+anon1([T|Ts]) ->
+ [T|anon1(Ts)].
+
+text(Ts) ->
+ lists:append(text1(Ts)).
+
+text1([]) -> [];
+text1([T|Ts]) ->
+ Anno = element(2, T),
+ [erl_anno:text(Anno) | text1(Ts)].
+
+-endif. % EXACT
diff --git a/lib/stdlib/test/sofs_SUITE.erl b/lib/stdlib/test/sofs_SUITE.erl
index 13c12ad2f2..f67bf16f0f 100644
--- a/lib/stdlib/test/sofs_SUITE.erl
+++ b/lib/stdlib/test/sofs_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2001-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2001-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -1837,11 +1837,8 @@ digraph(Conf) when is_list(Conf) ->
ok.
digraph_fail(ExitReason, Fail) ->
- {'EXIT', {ExitReason, [{sofs,family_to_digraph,A,_}|_]}} = Fail,
- case {test_server:is_native(sofs),A} of
- {false,[_,_]} -> ok;
- {true,2} -> ok
- end.
+ {'EXIT', {ExitReason, [{sofs,family_to_digraph,2,_}|_]}} = Fail,
+ ok.
constant_function(Conf) when is_list(Conf) ->
E = empty_set(),
diff --git a/lib/xmerl/src/xmerl_sax_parser.erl b/lib/xmerl/src/xmerl_sax_parser.erl
index 318a0cf7f4..1aef6c58c4 100644
--- a/lib/xmerl/src/xmerl_sax_parser.erl
+++ b/lib/xmerl/src/xmerl_sax_parser.erl
@@ -1,7 +1,7 @@
%%--------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -33,6 +33,7 @@
%% External exports
%%----------------------------------------------------------------------
-export([file/2,
+ stream/3,
stream/2]).
%%----------------------------------------------------------------------
@@ -72,11 +73,12 @@ file(Name,Options) ->
File = filename:basename(Name),
ContinuationFun = fun default_continuation_cb/1,
Res = stream(<<>>,
- [{continuation_fun, ContinuationFun},
- {continuation_state, FD},
- {current_location, CL},
- {entity, File}
- |Options]),
+ [{continuation_fun, ContinuationFun},
+ {continuation_state, FD},
+ {current_location, CL},
+ {entity, File}
+ |Options],
+ file),
ok = file:close(FD),
Res
end.
@@ -92,19 +94,22 @@ file(Name,Options) ->
%% EventState = term()
%% Description: Parse a stream containing an XML document.
%%----------------------------------------------------------------------
-stream(Xml, Options) when is_list(Xml), is_list(Options) ->
+stream(Xml, Options) ->
+ stream(Xml, Options, stream).
+
+stream(Xml, Options, InputType) when is_list(Xml), is_list(Options) ->
State = parse_options(Options, initial_state()),
- case State#xmerl_sax_parser_state.file_type of
+ case State#xmerl_sax_parser_state.file_type of
dtd ->
xmerl_sax_parser_list:parse_dtd(Xml,
State#xmerl_sax_parser_state{encoding = list,
- input_type = stream});
+ input_type = InputType});
normal ->
xmerl_sax_parser_list:parse(Xml,
State#xmerl_sax_parser_state{encoding = list,
- input_type = stream})
+ input_type = InputType})
end;
-stream(Xml, Options) when is_binary(Xml), is_list(Options) ->
+stream(Xml, Options, InputType) when is_binary(Xml), is_list(Options) ->
case parse_options(Options, initial_state()) of
{error, Reason} -> {error, Reason};
State ->
@@ -127,7 +132,7 @@ stream(Xml, Options) when is_binary(Xml), is_list(Options) ->
State#xmerl_sax_parser_state.event_state};
{Xml1, State1} ->
parse_binary(Xml1,
- State1#xmerl_sax_parser_state{input_type = stream},
+ State1#xmerl_sax_parser_state{input_type = InputType},
ParseFunction)
end
end.
@@ -226,12 +231,12 @@ check_encoding_option(E) ->
%% Description: Detects which character set is used in a binary stream.
%%----------------------------------------------------------------------
detect_charset(<<>>, #xmerl_sax_parser_state{continuation_fun = undefined} = _) ->
- throw({error, "Can't detect character encoding due to no indata"});
+ {error, "Can't detect character encoding due to no indata"};
detect_charset(<<>>, #xmerl_sax_parser_state{continuation_fun = CFun,
continuation_state = CState} = State) ->
case CFun(CState) of
{<<>>, _} ->
- throw({error, "Can't detect character encoding due to lack of indata"});
+ {error, "Can't detect character encoding due to lack of indata"};
{NewBytes, NewContState} ->
detect_charset(NewBytes, State#xmerl_sax_parser_state{continuation_state = NewContState})
end;
diff --git a/lib/xmerl/src/xmerl_sax_parser.hrl b/lib/xmerl/src/xmerl_sax_parser.hrl
index 932ab0cec5..7f9bf6c4d3 100644
--- a/lib/xmerl/src/xmerl_sax_parser.hrl
+++ b/lib/xmerl/src/xmerl_sax_parser.hrl
@@ -88,14 +88,7 @@
current_location, % Location of the currently parsed XML entity
entity, % Parsed XML entity
skip_external_dtd = false,% If true the external DTD is skipped during parsing
- input_type % Source type: file | stream.
- % This field is a preparation for an fix in R17 of a bug in
- % the conformance against the standard.
- % Today a file which contains two XML documents will be considered
- % well-formed and the second is placed in the rest part of the
- % return tuple, according to the conformance tests this should fail.
- % In the future this will fail if xmerl_sax_aprser:file/2 is used but
- % left to the user in the xmerl_sax_aprser:stream/2 case.
+ input_type % Source type: file | stream
}).
diff --git a/lib/xmerl/src/xmerl_sax_parser_base.erlsrc b/lib/xmerl/src/xmerl_sax_parser_base.erlsrc
index 4d75805b9b..2b9b37b5f3 100644
--- a/lib/xmerl/src/xmerl_sax_parser_base.erlsrc
+++ b/lib/xmerl/src/xmerl_sax_parser_base.erlsrc
@@ -1,7 +1,7 @@
%%-*-erlang-*-
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -72,7 +72,12 @@ parse(Xml, State) ->
{ok, Rest, State2} ->
State3 = event_callback(endDocument, State2),
ets:delete(RefTable),
- {ok, State3#xmerl_sax_parser_state.event_state, Rest};
+ case check_if_rest_ok(State3#xmerl_sax_parser_state.input_type, Rest) of
+ true ->
+ {ok, State3#xmerl_sax_parser_state.event_state, Rest};
+ false ->
+ format_error(fatal_error, State3, "Input found after legal document")
+ end;
{fatal_error, {State2, Reason}} ->
State3 = event_callback(endDocument, State2),
ets:delete(RefTable),
@@ -81,10 +86,14 @@ parse(Xml, State) ->
State3 = event_callback(endDocument, State2),
ets:delete(RefTable),
format_error(Tag, State3, Reason);
+ {endDocument, Rest, State2} ->
+ State3 = event_callback(endDocument, State2),
+ ets:delete(RefTable),
+ {ok, State3#xmerl_sax_parser_state.event_state, Rest};
Other ->
_State2 = event_callback(endDocument, State1),
ets:delete(RefTable),
- throw(Other)
+ {fatal_error, Other}
end.
%%----------------------------------------------------------------------
@@ -111,7 +120,7 @@ parse_dtd(Xml, State) ->
{Rest, State2} when is_record(State2, xmerl_sax_parser_state) ->
State3 = event_callback(endDocument, State2),
ets:delete(RefTable),
- {ok, State3#xmerl_sax_parser_state.event_state, Rest};
+ {ok, State3#xmerl_sax_parser_state.event_state, Rest};
{endDocument, Rest, State2} when is_record(State2, xmerl_sax_parser_state) ->
State3 = event_callback(endDocument, State2),
ets:delete(RefTable),
@@ -119,7 +128,7 @@ parse_dtd(Xml, State) ->
Other ->
_State2 = event_callback(endDocument, State1),
ets:delete(RefTable),
- throw(Other)
+ {fatal_error, Other}
end.
@@ -442,6 +451,15 @@ check_if_new_doc_allowed(stream, []) ->
check_if_new_doc_allowed(_, _) ->
false.
+check_if_rest_ok(file, []) ->
+ true;
+check_if_rest_ok(file, <<>>) ->
+ true;
+check_if_rest_ok(stream, _) ->
+ true;
+check_if_rest_ok(_, _) ->
+ false.
+
%%----------------------------------------------------------------------
%% Function: parse_pi_1(Rest, State) -> Result
%% Input: Rest = string() | binary()
@@ -1024,16 +1042,21 @@ parse_etag(Bytes, State) ->
unicode_incomplete_check([Bytes, State, fun parse_etag/2],
undefined).
-
parse_etag_1(?STRING_REST(">", Rest),
#xmerl_sax_parser_state{end_tags=[{_ETag, Uri, LocalName, QName, OldNsList, NewNsList}
- |RestOfETags]} = State, _Tag) ->
+ |RestOfETags],
+ input_type=InputType} = State, _Tag) ->
State1 = event_callback({endElement, Uri, LocalName, QName}, State),
State2 = send_end_prefix_mapping_event(NewNsList, State1),
- parse_content(Rest,
- State2#xmerl_sax_parser_state{end_tags=RestOfETags,
- ns = OldNsList},
- [], true);
+ case check_if_new_doc_allowed(InputType, RestOfETags) of
+ true ->
+ throw({endDocument, Rest, State2#xmerl_sax_parser_state{ns = OldNsList}});
+ false ->
+ parse_content(Rest,
+ State2#xmerl_sax_parser_state{end_tags=RestOfETags,
+ ns = OldNsList},
+ [], true)
+ end;
parse_etag_1(?STRING_UNBOUND_REST(_C, _), State, Tag) ->
{P,TN} = Tag,
?fatal_error(State, "Bad EndTag: " ++ P ++ ":" ++ TN);
@@ -1051,21 +1074,26 @@ parse_etag_1(Bytes, State, Tag) ->
%% Description: Parsing the content part of tags
%% [43] content ::= (element | CharData | Reference | CDSect | PI | Comment)*
%%----------------------------------------------------------------------
-
parse_content(?STRING_EMPTY, State, Acc, IgnorableWS) ->
- case catch cf(?STRING_EMPTY, State, Acc, IgnorableWS, fun parse_content/4) of
- {Rest, State1} when is_record(State1, xmerl_sax_parser_state) ->
- {Rest, State1};
- {fatal_error, {State1, Msg}} ->
- case check_if_document_complete(State1, Msg) of
- true ->
- State2 = send_character_event(length(Acc), IgnorableWS, lists:reverse(Acc), State1),
- {?STRING_EMPTY, State2};
- false ->
- ?fatal_error(State1, Msg)
- end;
- Other ->
- throw(Other)
+ case check_if_document_complete(State, "No more bytes") of
+ true ->
+ State1 = send_character_event(length(Acc), IgnorableWS, lists:reverse(Acc), State),
+ {?STRING_EMPTY, State1};
+ false ->
+ case catch cf(?STRING_EMPTY, State, Acc, IgnorableWS, fun parse_content/4) of
+ {Rest, State1} when is_record(State1, xmerl_sax_parser_state) ->
+ {Rest, State1};
+ {fatal_error, {State1, Msg}} ->
+ case check_if_document_complete(State1, Msg) of
+ true ->
+ State2 = send_character_event(length(Acc), IgnorableWS, lists:reverse(Acc), State1),
+ {?STRING_EMPTY, State2};
+ false ->
+ ?fatal_error(State1, Msg)
+ end;
+ Other ->
+ throw(Other)
+ end
end;
parse_content(?STRING("\r") = Bytes, State, Acc, IgnorableWS) ->
cf(Bytes, State, Acc, IgnorableWS, fun parse_content/4);
@@ -1094,7 +1122,7 @@ parse_content(?STRING_REST("<?", Rest), State, Acc, IgnorableWS) ->
parse_content(?STRING_REST("<!", Rest1) = Rest, #xmerl_sax_parser_state{end_tags = ET} = State, Acc, IgnorableWS) ->
case ET of
[] ->
- {Rest, State}; %%LATH : Skicka ignorable WS ???
+ {Rest, State}; %% Skicka ignorable WS ???
_ ->
State1 = send_character_event(length(Acc), IgnorableWS, lists:reverse(Acc), State),
parse_cdata(Rest1, State1)
@@ -1102,7 +1130,7 @@ parse_content(?STRING_REST("<!", Rest1) = Rest, #xmerl_sax_parser_state{end_tags
parse_content(?STRING_REST("<", Rest1) = Rest, #xmerl_sax_parser_state{end_tags = ET} = State, Acc, IgnorableWS) ->
case ET of
[] ->
- {Rest, State}; %%LATH : Skicka ignorable WS ???
+ {Rest, State}; %% Skicka ignorable WS ???
_ ->
State1 = send_character_event(length(Acc), IgnorableWS, lists:reverse(Acc), State),
parse_stag(Rest1, State1)
@@ -3290,7 +3318,7 @@ cf(Rest, #xmerl_sax_parser_state{continuation_fun = CFun, continuation_state = C
catch
throw:ErrorTerm ->
?fatal_error(State, ErrorTerm);
- exit:Reason ->
+ exit:Reason ->
?fatal_error(State, {'EXIT', Reason})
end,
case Result of
diff --git a/lib/xmerl/test/Makefile b/lib/xmerl/test/Makefile
index 7a326e334f..b13fee05b3 100644
--- a/lib/xmerl/test/Makefile
+++ b/lib/xmerl/test/Makefile
@@ -55,7 +55,8 @@ SUITE_FILES= \
xmerl_xsd_SUITE.erl \
xmerl_xsd_MS2002-01-16_SUITE.erl \
xmerl_xsd_NIST2002-01-16_SUITE.erl \
- xmerl_xsd_Sun2002-01-16_SUITE.erl
+ xmerl_xsd_Sun2002-01-16_SUITE.erl \
+ xmerl_sax_stream_SUITE.erl
XML_FILES= \
testcases.dtd \
@@ -125,4 +126,5 @@ release_tests_spec: opt
@tar cfh - xmerl_xsd_MS2002-01-16_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -)
@tar cfh - xmerl_xsd_NIST2002-01-16_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -)
@tar cfh - xmerl_xsd_Sun2002-01-16_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -)
+ @tar cfh - xmerl_sax_stream_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -)
chmod -R u+w "$(RELSYSDIR)"
diff --git a/lib/xmerl/test/xmerl_sax_SUITE.erl b/lib/xmerl/test/xmerl_sax_SUITE.erl
index f5c0a783c4..7d1a70905c 100644
--- a/lib/xmerl/test/xmerl_sax_SUITE.erl
+++ b/lib/xmerl/test/xmerl_sax_SUITE.erl
@@ -85,17 +85,17 @@ ticket_11551(_Config) ->
<a>hej</a>
<?xml version=\"1.0\" encoding=\"utf-8\" ?>
<a>hej</a>">>,
- {ok, undefined, <<"<?xml", _/binary>>} = xmerl_sax_parser:stream(Stream1, []),
+ {ok, undefined, <<"\n<?xml", _/binary>>} = xmerl_sax_parser:stream(Stream1, []),
Stream2= <<"<?xml version=\"1.0\" encoding=\"utf-8\" ?>
<a>hej</a>
<?xml version=\"1.0\" encoding=\"utf-8\" ?>
<a>hej</a>">>,
- {ok, undefined, <<"<?xml", _/binary>>} = xmerl_sax_parser:stream(Stream2, []),
+ {ok, undefined, <<"\n\n\n<?xml", _/binary>>} = xmerl_sax_parser:stream(Stream2, []),
Stream3= <<"<a>hej</a>
<?xml version=\"1.0\" encoding=\"utf-8\" ?>
<a>hej</a>">>,
- {ok, undefined, <<"<?xml", _/binary>>} = xmerl_sax_parser:stream(Stream3, []),
+ {ok, undefined, <<"\n\n<?xml", _/binary>>} = xmerl_sax_parser:stream(Stream3, []),
ok.
diff --git a/lib/xmerl/test/xmerl_sax_std_SUITE.erl b/lib/xmerl/test/xmerl_sax_std_SUITE.erl
index 525a3b175a..b8412206cc 100644
--- a/lib/xmerl/test/xmerl_sax_std_SUITE.erl
+++ b/lib/xmerl/test/xmerl_sax_std_SUITE.erl
@@ -2,7 +2,7 @@
%%----------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -507,11 +507,8 @@ end_per_testcase(_Func,_Config) ->
'not-wf-sa-036'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"xmltest","not-wf/sa/036.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_,<<"Illegal data\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -522,11 +519,8 @@ end_per_testcase(_Func,_Config) ->
'not-wf-sa-037'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"xmltest","not-wf/sa/037.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_,<<"&#32;\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -561,11 +555,8 @@ end_per_testcase(_Func,_Config) ->
'not-wf-sa-040'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"xmltest","not-wf/sa/040.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_,<<"<doc></doc>\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -576,11 +567,8 @@ end_per_testcase(_Func,_Config) ->
'not-wf-sa-041'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"xmltest","not-wf/sa/041.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_,<<"<doc></doc>\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -603,11 +591,8 @@ end_per_testcase(_Func,_Config) ->
'not-wf-sa-043'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"xmltest","not-wf/sa/043.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_,<<"Illegal data\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -618,11 +603,8 @@ end_per_testcase(_Func,_Config) ->
'not-wf-sa-044'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"xmltest","not-wf/sa/044.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_,<<"<doc/>\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -669,11 +651,8 @@ end_per_testcase(_Func,_Config) ->
'not-wf-sa-048'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"xmltest","not-wf/sa/048.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_,<<"<![CDATA[]]>\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -1416,11 +1395,8 @@ end_per_testcase(_Func,_Config) ->
'not-wf-sa-110'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"xmltest","not-wf/sa/110.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_,<<"&e;\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -1914,9 +1890,9 @@ end_per_testcase(_Func,_Config) ->
%% Special case becase we returns everything after a legal document
%% as an rest instead of giving and error to let the user handle
%% multipple docs on a stream.
- {ok,_,<<"<?xml version=\"1.0\"?>\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- % R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
- % check_result(R, "not-wf").
+ %{ok,_,<<"<?xml version=\"1.0\"?>\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -7784,11 +7760,8 @@ end_per_testcase(_Func,_Config) ->
'o-p01fail3'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"oasis","p01fail3.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_, <<"<bad/>", _/binary>>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -11417,12 +11390,8 @@ end_per_testcase(_Func,_Config) ->
'ibm-not-wf-P01-ibm01n02'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"ibm","not-wf/P01/ibm01n02.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_, <<"<?xml version=\"1.0\"?>", _/binary>>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- % R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
- % check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -11433,11 +11402,8 @@ end_per_testcase(_Func,_Config) ->
'ibm-not-wf-P01-ibm01n03'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"ibm","not-wf/P01/ibm01n03.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_, <<"<title>Wrong combination!</title>", _/binary>>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Cases
@@ -13027,11 +12993,8 @@ end_per_testcase(_Func,_Config) ->
'ibm-not-wf-P27-ibm27n01'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"ibm","not-wf/P27/ibm27n01.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_, <<"<!ELEMENT cat EMPTY>">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Cases
@@ -13461,11 +13424,8 @@ end_per_testcase(_Func,_Config) ->
'ibm-not-wf-P39-ibm39n06'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"ibm","not-wf/P39/ibm39n06.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_,<<"content after end tag\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Cases
diff --git a/lib/xmerl/test/xmerl_sax_stream_SUITE.erl b/lib/xmerl/test/xmerl_sax_stream_SUITE.erl
new file mode 100644
index 0000000000..a306eb66a2
--- /dev/null
+++ b/lib/xmerl/test/xmerl_sax_stream_SUITE.erl
@@ -0,0 +1,245 @@
+%%-*-erlang-*-
+%%----------------------------------------------------------------------
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%----------------------------------------------------------------------
+%% File : xmerl_sax_stream_SUITE.erl
+%%----------------------------------------------------------------------
+-module(xmerl_sax_stream_SUITE).
+-compile(export_all).
+
+%%----------------------------------------------------------------------
+%% Include files
+%%----------------------------------------------------------------------
+-include_lib("common_test/include/ct.hrl").
+-include_lib("kernel/include/file.hrl").
+
+%%======================================================================
+%% External functions
+%%======================================================================
+
+%%----------------------------------------------------------------------
+%% Initializations
+%%----------------------------------------------------------------------
+all() ->
+ [
+ one_document,
+ two_documents,
+ one_document_and_junk
+ ].
+
+%%----------------------------------------------------------------------
+%% Initializations
+%%----------------------------------------------------------------------
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_testcase(_TestCase, Config) ->
+ Config.
+
+end_per_testcase(_Func, _Config) ->
+ ok.
+
+%%----------------------------------------------------------------------
+%% Tests
+%%----------------------------------------------------------------------
+one_document(Config) ->
+ Port = 11111,
+
+ {ok, ListenSocket} = listen(Port),
+ Self = self(),
+
+ spawn(
+ fun() ->
+ case catch gen_tcp:accept(ListenSocket) of
+ {ok, S} ->
+ Result = xmerl_sax_parser:stream(<<>>,
+ [{continuation_state, S},
+ {continuation_fun,
+ fun(Sd) ->
+ io:format("Continuation called!!", []),
+ case gen_tcp:recv(Sd, 0) of
+ {ok, Packet} ->
+ io:format("Packet: ~p\n", [Packet]),
+ {Packet, Sd};
+ {error, Reason} ->
+ throw({error, Reason})
+ end
+ end}]),
+ Self ! {xmerl_sax, Result},
+ close(S);
+ Error ->
+ Self ! {xmerl_sax, {error, {accept, Error}}}
+ end
+ end),
+
+ {ok, SendSocket} = connect(localhost, Port),
+
+ {ok, Binary} = file:read_file(filename:join([datadir(Config), "xmerl_sax_stream_one.xml"])),
+
+ send_chunks(SendSocket, Binary),
+
+ receive
+ {xmerl_sax, {ok, undefined, Rest}} ->
+ <<"\n">> = Rest,
+ io:format("Ok Rest: ~p\n", [Rest])
+ after 5000 ->
+ ct:fail("Timeout")
+ end,
+ ok.
+
+two_documents(Config) ->
+ Port = 11111,
+
+ {ok, ListenSocket} = listen(Port),
+ Self = self(),
+
+ spawn(
+ fun() ->
+ case catch gen_tcp:accept(ListenSocket) of
+ {ok, S} ->
+ Result = xmerl_sax_parser:stream(<<>>,
+ [{continuation_state, S},
+ {continuation_fun,
+ fun(Sd) ->
+ io:format("Continuation called!!", []),
+ case gen_tcp:recv(Sd, 0) of
+ {ok, Packet} ->
+ io:format("Packet: ~p\n", [Packet]),
+ {Packet, Sd};
+ {error, Reason} ->
+ throw({error, Reason})
+ end
+ end}]),
+ Self ! {xmerl_sax, Result},
+ close(S);
+ Error ->
+ Self ! {xmerl_sax, {error, {accept, Error}}}
+ end
+ end),
+
+ {ok, SendSocket} = connect(localhost, Port),
+
+ {ok, Binary} = file:read_file(filename:join([datadir(Config), "xmerl_sax_stream_two.xml"])),
+
+ send_chunks(SendSocket, Binary),
+
+ receive
+ {xmerl_sax, {ok, undefined, Rest}} ->
+ <<"\n<?x", _R/binary>> = Rest,
+ io:format("Ok Rest: ~p\n", [Rest])
+ after 5000 ->
+ ct:fail("Timeout")
+ end,
+ ok.
+
+one_document_and_junk(Config) ->
+ Port = 11111,
+
+ {ok, ListenSocket} = listen(Port),
+ Self = self(),
+
+ spawn(
+ fun() ->
+ case catch gen_tcp:accept(ListenSocket) of
+ {ok, S} ->
+ Result = xmerl_sax_parser:stream(<<>>,
+ [{continuation_state, S},
+ {continuation_fun,
+ fun(Sd) ->
+ io:format("Continuation called!!", []),
+ case gen_tcp:recv(Sd, 0) of
+ {ok, Packet} ->
+ io:format("Packet: ~p\n", [Packet]),
+ {Packet, Sd};
+ {error, Reason} ->
+ throw({error, Reason})
+ end
+ end}]),
+ Self ! {xmerl_sax, Result},
+ close(S);
+ Error ->
+ Self ! {xmerl_sax, {error, {accept, Error}}}
+ end
+ end),
+
+ {ok, SendSocket} = connect(localhost, Port),
+
+ {ok, Binary} = file:read_file(filename:join([datadir(Config), "xmerl_sax_stream_one_junk.xml"])),
+
+ send_chunks(SendSocket, Binary),
+
+ receive
+ {xmerl_sax, {ok, undefined, Rest}} ->
+ <<"\nth", _R/binary>> = Rest,
+ io:format("Ok Rest: ~p\n", [Rest])
+ after 10000 ->
+ ct:fail("Timeout")
+ end,
+ ok.
+
+%%----------------------------------------------------------------------
+%% Utility functions
+%%----------------------------------------------------------------------
+listen(Port) ->
+ case catch gen_tcp:listen(Port, [{active, false},
+ binary,
+ {keepalive, true},
+ {reuseaddr,true}]) of
+ {ok, ListenSocket} ->
+ {ok, ListenSocket};
+ {error, Reason} ->
+ {error, {listen, Reason}}
+ end.
+
+close(Socket) ->
+ (catch gen_tcp:close(Socket)).
+
+connect(Host, Port) ->
+ Timeout = 5000,
+ % Options1 = check_options(Options),
+ Options = [binary],
+ case catch gen_tcp:connect(Host, Port, Options, Timeout) of
+ {ok, Socket} ->
+ {ok, Socket};
+ {error, Reason} ->
+ {error, Reason}
+ end.
+
+send_chunks(Socket, Binary) ->
+ BSize = erlang:size(Binary),
+ if
+ BSize > 25 ->
+ <<Head:25/binary, Tail/binary>> = Binary,
+ case gen_tcp:send(Socket, Head) of
+ ok ->
+ timer:sleep(1000),
+ send_chunks(Socket, Tail);
+ {error,closed} ->
+ ok
+ end;
+ true ->
+ gen_tcp:send(Socket, Binary)
+ end.
+
+datadir(Config) ->
+ proplists:get_value(data_dir, Config).
diff --git a/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_one.xml b/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_one.xml
new file mode 100644
index 0000000000..30328bb188
--- /dev/null
+++ b/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_one.xml
@@ -0,0 +1,17 @@
+<?xml version="1.0"?>
+<person>
+<name>
+Arne Andersson
+</name>
+<address>
+<street>
+ Old Road 456
+</street>
+<zip>
+12323
+</zip>
+<city>
+Small City
+</city>
+</address>
+</person>
diff --git a/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_one_junk.xml b/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_one_junk.xml
new file mode 100644
index 0000000000..f730a95865
--- /dev/null
+++ b/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_one_junk.xml
@@ -0,0 +1,18 @@
+<?xml version="1.0"?>
+<person>
+<name>
+Arne Andersson
+</name>
+<address>
+<street>
+ Old Road 456
+</street>
+<zip>
+12323
+</zip>
+<city>
+Small City
+</city>
+</address>
+</person>
+this is junk ......
diff --git a/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_two.xml b/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_two.xml
new file mode 100644
index 0000000000..e241a02190
--- /dev/null
+++ b/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_two.xml
@@ -0,0 +1,34 @@
+<?xml version="1.0"?>
+<person>
+<name>
+Arne Andersson
+</name>
+<address>
+<street>
+ Old Road 456
+</street>
+<zip>
+12323
+</zip>
+<city>
+Small City
+</city>
+</address>
+</person>
+<?xml version="1.0"?>
+<person>
+<name>
+Bertil Bengtson
+</name>
+<address>
+<street>
+ New Road 4
+</street>
+<zip>
+12328
+</zip>
+<city>
+Small City
+</city>
+</address>
+</person>