aboutsummaryrefslogtreecommitdiffstats
path: root/lib/stdlib/src
diff options
context:
space:
mode:
Diffstat (limited to 'lib/stdlib/src')
-rw-r--r--lib/stdlib/src/Makefile13
-rw-r--r--lib/stdlib/src/array.erl2
-rw-r--r--lib/stdlib/src/base64.erl623
-rw-r--r--lib/stdlib/src/beam_lib.erl30
-rw-r--r--lib/stdlib/src/binary.erl30
-rw-r--r--lib/stdlib/src/c.erl28
-rw-r--r--lib/stdlib/src/calendar.erl185
-rw-r--r--lib/stdlib/src/dets.erl37
-rw-r--r--lib/stdlib/src/dets_utils.erl5
-rw-r--r--lib/stdlib/src/edlin.erl2
-rw-r--r--lib/stdlib/src/epp.erl145
-rw-r--r--lib/stdlib/src/erl_compile.erl3
-rw-r--r--lib/stdlib/src/erl_error.erl (renamed from lib/stdlib/src/lib.erl)329
-rw-r--r--lib/stdlib/src/erl_eval.erl408
-rw-r--r--lib/stdlib/src/erl_internal.erl6
-rw-r--r--lib/stdlib/src/erl_lint.erl127
-rw-r--r--lib/stdlib/src/erl_parse.yrl88
-rw-r--r--lib/stdlib/src/erl_posix_msg.erl7
-rw-r--r--lib/stdlib/src/erl_pp.erl44
-rw-r--r--lib/stdlib/src/erl_scan.erl6
-rw-r--r--lib/stdlib/src/erl_tar.erl80
-rw-r--r--lib/stdlib/src/erl_tar.hrl16
-rw-r--r--lib/stdlib/src/escript.erl34
-rw-r--r--lib/stdlib/src/ets.erl51
-rw-r--r--lib/stdlib/src/eval_bits.erl21
-rw-r--r--lib/stdlib/src/file_sorter.erl10
-rw-r--r--lib/stdlib/src/filelib.erl42
-rw-r--r--lib/stdlib/src/filename.erl137
-rw-r--r--lib/stdlib/src/gen.erl87
-rw-r--r--lib/stdlib/src/gen_event.erl93
-rw-r--r--lib/stdlib/src/gen_fsm.erl91
-rw-r--r--lib/stdlib/src/gen_server.erl174
-rw-r--r--lib/stdlib/src/gen_statem.erl289
-rw-r--r--lib/stdlib/src/io.erl13
-rw-r--r--lib/stdlib/src/io_lib.erl247
-rw-r--r--lib/stdlib/src/io_lib_format.erl300
-rw-r--r--lib/stdlib/src/io_lib_pretty.erl678
-rw-r--r--lib/stdlib/src/lists.erl19
-rw-r--r--lib/stdlib/src/maps.erl128
-rw-r--r--lib/stdlib/src/ms_transform.erl13
-rw-r--r--lib/stdlib/src/ordsets.erl11
-rw-r--r--lib/stdlib/src/otp_internal.erl16
-rw-r--r--lib/stdlib/src/pool.erl8
-rw-r--r--lib/stdlib/src/proc_lib.erl140
-rw-r--r--lib/stdlib/src/qlc.erl63
-rw-r--r--lib/stdlib/src/rand.erl261
-rw-r--r--lib/stdlib/src/sets.erl10
-rw-r--r--lib/stdlib/src/shell.erl15
-rw-r--r--lib/stdlib/src/slave.erl18
-rw-r--r--lib/stdlib/src/stdlib.app.src7
-rw-r--r--lib/stdlib/src/stdlib.appup.src10
-rw-r--r--lib/stdlib/src/string.erl183
-rw-r--r--lib/stdlib/src/supervisor.erl997
-rw-r--r--lib/stdlib/src/supervisor_bridge.erl29
-rw-r--r--lib/stdlib/src/sys.erl59
-rw-r--r--lib/stdlib/src/uri_string.erl2148
-rw-r--r--lib/stdlib/src/zip.erl5
57 files changed, 6288 insertions, 2333 deletions
diff --git a/lib/stdlib/src/Makefile b/lib/stdlib/src/Makefile
index bf836203ec..c95f7637f7 100644
--- a/lib/stdlib/src/Makefile
+++ b/lib/stdlib/src/Makefile
@@ -1,7 +1,7 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 1996-2017. All Rights Reserved.
+# Copyright Ericsson AB 1996-2018. All Rights Reserved.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
@@ -62,6 +62,7 @@ MODULES= \
erl_anno \
erl_bits \
erl_compile \
+ erl_error \
erl_eval \
erl_expand_records \
erl_internal \
@@ -91,7 +92,6 @@ MODULES= \
io_lib_format \
io_lib_fread \
io_lib_pretty \
- lib \
lists \
log_mf_h \
maps \
@@ -121,6 +121,7 @@ MODULES= \
timer \
unicode \
unicode_util \
+ uri_string \
win32reg \
zip
@@ -175,6 +176,7 @@ docs:
primary_bootstrap_compiler: \
$(BOOTSTRAP_COMPILER)/ebin/epp.beam \
$(BOOTSTRAP_COMPILER)/ebin/erl_anno.beam \
+ $(BOOTSTRAP_COMPILER)/ebin/erl_error.beam \
$(BOOTSTRAP_COMPILER)/ebin/erl_scan.beam \
$(BOOTSTRAP_COMPILER)/ebin/erl_parse.beam \
$(BOOTSTRAP_COMPILER)/ebin/erl_lint.beam \
@@ -237,6 +239,13 @@ $(EBIN)/erl_tar.beam: ../../kernel/include/file.hrl erl_tar.hrl
$(EBIN)/file_sorter.beam: ../../kernel/include/file.hrl
$(EBIN)/filelib.beam: ../../kernel/include/file.hrl
$(EBIN)/filename.beam: ../../kernel/include/file.hrl
+$(EBIN)/gen_event.beam: ../../kernel/include/logger.hrl
+$(EBIN)/gen_fsm.beam: ../../kernel/include/logger.hrl
+$(EBIN)/gen_server.beam: ../../kernel/include/logger.hrl
+$(EBIN)/gen_statem.beam: ../../kernel/include/logger.hrl
+$(EBIN)/proc_lib.beam: ../../kernel/include/logger.hrl
$(EBIN)/qlc_pt.beam: ../include/ms_transform.hrl
$(EBIN)/shell.beam: ../../kernel/include/file.hrl
+$(EBIN)/supervisor.beam: ../../kernel/include/logger.hrl
+$(EBIN)/supervisor_bridge.beam: ../../kernel/include/logger.hrl
$(EBIN)/zip.beam: ../include/zip.hrl ../../kernel/include/file.hrl
diff --git a/lib/stdlib/src/array.erl b/lib/stdlib/src/array.erl
index a237eaa489..939b1fb488 100644
--- a/lib/stdlib/src/array.erl
+++ b/lib/stdlib/src/array.erl
@@ -290,7 +290,7 @@ new(Size, Fixed, Default) ->
end,
#array{size = Size, max = M, default = Default, elements = E}.
--spec find_max(integer(), integer()) -> integer().
+-spec find_max(integer(), non_neg_integer()) -> non_neg_integer().
find_max(I, M) when I >= M ->
find_max(I, ?extend(M));
diff --git a/lib/stdlib/src/base64.erl b/lib/stdlib/src/base64.erl
index 5885745fb1..6ea4147abf 100644
--- a/lib/stdlib/src/base64.erl
+++ b/lib/stdlib/src/base64.erl
@@ -24,22 +24,11 @@
-export([encode/1, decode/1, mime_decode/1,
encode_to_string/1, decode_to_string/1, mime_decode_to_string/1]).
-%%-------------------------------------------------------------------------
%% The following type is a subtype of string() for return values
%% of (some) functions of this module.
-%%-------------------------------------------------------------------------
-
-type ascii_string() :: [1..255].
-type ascii_binary() :: binary().
-%%-------------------------------------------------------------------------
-%% encode_to_string(ASCII) -> Base64String
-%% ASCII - string() | binary()
-%% Base64String - string()
-%%
-%% Description: Encodes a plain ASCII string (or binary) into base64.
-%%-------------------------------------------------------------------------
-
-spec encode_to_string(Data) -> Base64String when
Data :: ascii_string() | ascii_binary(),
Base64String :: ascii_string().
@@ -47,107 +36,89 @@
encode_to_string(Bin) when is_binary(Bin) ->
encode_to_string(binary_to_list(Bin));
encode_to_string(List) when is_list(List) ->
- encode_l(List).
-
-%%-------------------------------------------------------------------------
-%% encode(ASCII) -> Base64
-%% ASCII - string() | binary()
-%% Base64 - binary()
-%%
-%% Description: Encodes a plain ASCII string (or binary) into base64.
-%%-------------------------------------------------------------------------
+ encode_list_to_string(List).
-spec encode(Data) -> Base64 when
Data :: ascii_string() | ascii_binary(),
Base64 :: ascii_binary().
encode(Bin) when is_binary(Bin) ->
- encode_binary(Bin);
+ encode_binary(Bin, <<>>);
encode(List) when is_list(List) ->
- list_to_binary(encode_l(List)).
+ encode_list(List, <<>>).
--spec encode_l(ascii_string()) -> ascii_string().
-
-encode_l([]) ->
+encode_list_to_string([]) ->
[];
-encode_l([A]) ->
- [b64e(A bsr 2),
- b64e((A band 3) bsl 4), $=, $=];
-encode_l([A,B]) ->
- [b64e(A bsr 2),
- b64e(((A band 3) bsl 4) bor (B bsr 4)),
- b64e((B band 15) bsl 2), $=];
-encode_l([A,B,C|Ls]) ->
- BB = (A bsl 16) bor (B bsl 8) bor C,
+encode_list_to_string([B1]) ->
+ [b64e(B1 bsr 2),
+ b64e((B1 band 3) bsl 4), $=, $=];
+encode_list_to_string([B1,B2]) ->
+ [b64e(B1 bsr 2),
+ b64e(((B1 band 3) bsl 4) bor (B2 bsr 4)),
+ b64e((B2 band 15) bsl 2), $=];
+encode_list_to_string([B1,B2,B3|Ls]) ->
+ BB = (B1 bsl 16) bor (B2 bsl 8) bor B3,
[b64e(BB bsr 18),
b64e((BB bsr 12) band 63),
b64e((BB bsr 6) band 63),
- b64e(BB band 63) | encode_l(Ls)].
-
-encode_binary(Bin) ->
- Split = 3*(byte_size(Bin) div 3),
- <<Main0:Split/binary,Rest/binary>> = Bin,
- Main = << <<(b64e(C)):8>> || <<C:6>> <= Main0 >>,
- case Rest of
- <<A:6,B:6,C:4>> ->
- <<Main/binary,(b64e(A)):8,(b64e(B)):8,(b64e(C bsl 2)):8,$=:8>>;
- <<A:6,B:2>> ->
- <<Main/binary,(b64e(A)):8,(b64e(B bsl 4)):8,$=:8,$=:8>>;
- <<>> ->
- Main
- end.
+ b64e(BB band 63) | encode_list_to_string(Ls)].
-%%-------------------------------------------------------------------------
-%% mime_decode(Base64) -> ASCII
-%% decode(Base64) -> ASCII
-%% Base64 - string() | binary()
-%% ASCII - binary()
-%%
-%% Description: Decodes an base64 encoded string to plain ASCII.
-%% mime_decode strips away all characters not Base64 before converting,
-%% whereas decode crashes if an illegal character is found
-%%-------------------------------------------------------------------------
+encode_binary(<<>>, A) ->
+ A;
+encode_binary(<<B1:8>>, A) ->
+ <<A/bits,(b64e(B1 bsr 2)):8,(b64e((B1 band 3) bsl 4)):8,$=:8,$=:8>>;
+encode_binary(<<B1:8, B2:8>>, A) ->
+ <<A/bits,(b64e(B1 bsr 2)):8,
+ (b64e(((B1 band 3) bsl 4) bor (B2 bsr 4))):8,
+ (b64e((B2 band 15) bsl 2)):8, $=:8>>;
+encode_binary(<<B1:8, B2:8, B3:8, Ls/bits>>, A) ->
+ BB = (B1 bsl 16) bor (B2 bsl 8) bor B3,
+ encode_binary(Ls,
+ <<A/bits,(b64e(BB bsr 18)):8,
+ (b64e((BB bsr 12) band 63)):8,
+ (b64e((BB bsr 6) band 63)):8,
+ (b64e(BB band 63)):8>>).
+
+encode_list([], A) ->
+ A;
+encode_list([B1], A) ->
+ <<A/bits,(b64e(B1 bsr 2)):8,(b64e((B1 band 3) bsl 4)):8,$=:8,$=:8>>;
+encode_list([B1,B2], A) ->
+ <<A/bits,(b64e(B1 bsr 2)):8,
+ (b64e(((B1 band 3) bsl 4) bor (B2 bsr 4))):8,
+ (b64e((B2 band 15) bsl 2)):8, $=:8>>;
+encode_list([B1,B2,B3|Ls], A) ->
+ BB = (B1 bsl 16) bor (B2 bsl 8) bor B3,
+ encode_list(Ls,
+ <<A/bits,(b64e(BB bsr 18)):8,
+ (b64e((BB bsr 12) band 63)):8,
+ (b64e((BB bsr 6) band 63)):8,
+ (b64e(BB band 63)):8>>).
+
+%% mime_decode strips away all characters not Base64 before
+%% converting, whereas decode crashes if an illegal character is found
-spec decode(Base64) -> Data when
Base64 :: ascii_string() | ascii_binary(),
Data :: ascii_binary().
decode(Bin) when is_binary(Bin) ->
- decode_binary(<<>>, Bin);
+ decode_binary(Bin, <<>>);
decode(List) when is_list(List) ->
- list_to_binary(decode_l(List)).
+ decode_list(List, <<>>).
-spec mime_decode(Base64) -> Data when
Base64 :: ascii_string() | ascii_binary(),
Data :: ascii_binary().
mime_decode(Bin) when is_binary(Bin) ->
- mime_decode_binary(<<>>, Bin);
+ mime_decode_binary(Bin, <<>>);
mime_decode(List) when is_list(List) ->
- mime_decode(list_to_binary(List)).
-
--spec decode_l(ascii_string()) -> ascii_string().
-
-decode_l(List) ->
- L = strip_spaces(List, []),
- decode(L, []).
-
--spec mime_decode_l(ascii_string()) -> ascii_string().
+ mime_decode_list(List, <<>>).
-mime_decode_l(List) ->
- L = strip_illegal(List, [], 0),
- decode(L, []).
-
-%%-------------------------------------------------------------------------
-%% mime_decode_to_string(Base64) -> ASCII
-%% decode_to_string(Base64) -> ASCII
-%% Base64 - string() | binary()
-%% ASCII - binary()
-%%
-%% Description: Decodes an base64 encoded string to plain ASCII.
-%% mime_decode strips away all characters not Base64 before converting,
-%% whereas decode crashes if an illegal character is found
-%%-------------------------------------------------------------------------
+%% mime_decode_to_string strips away all characters not Base64 before
+%% converting, whereas decode_to_string crashes if an illegal
+%% character is found
-spec decode_to_string(Base64) -> DataString when
Base64 :: ascii_string() | ascii_binary(),
@@ -156,7 +127,7 @@ mime_decode_l(List) ->
decode_to_string(Bin) when is_binary(Bin) ->
decode_to_string(binary_to_list(Bin));
decode_to_string(List) when is_list(List) ->
- decode_l(List).
+ decode_list_to_string(List).
-spec mime_decode_to_string(Base64) -> DataString when
Base64 :: ascii_string() | ascii_binary(),
@@ -165,202 +136,326 @@ decode_to_string(List) when is_list(List) ->
mime_decode_to_string(Bin) when is_binary(Bin) ->
mime_decode_to_string(binary_to_list(Bin));
mime_decode_to_string(List) when is_list(List) ->
- mime_decode_l(List).
-
-%% One-based decode map.
--define(DECODE_MAP,
- {bad,bad,bad,bad,bad,bad,bad,bad,ws,ws,bad,bad,ws,bad,bad, %1-15
- bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad, %16-31
- ws,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,62,bad,bad,bad,63, %32-47
- 52,53,54,55,56,57,58,59,60,61,bad,bad,bad,eq,bad,bad, %48-63
- bad,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,
- 15,16,17,18,19,20,21,22,23,24,25,bad,bad,bad,bad,bad,
- bad,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,
- 41,42,43,44,45,46,47,48,49,50,51,bad,bad,bad,bad,bad,
- bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,
- bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,
- bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,
- bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,
- bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,
- bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,
- bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,
- bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad}).
-
-decode_binary(Result0, <<C:8,T0/bits>>) ->
- case element(C, ?DECODE_MAP) of
- bad ->
- erlang:error({badarg,C});
- ws ->
- decode_binary(Result0, T0);
- eq ->
- case strip_ws(T0) of
- <<$=:8,T/binary>> ->
- <<>> = strip_ws(T),
- Split = byte_size(Result0) - 1,
- <<Result:Split/bytes,_:4>> = Result0,
- Result;
- T ->
- <<>> = strip_ws(T),
- Split = byte_size(Result0) - 1,
- <<Result:Split/bytes,_:2>> = Result0,
- Result
- end;
- Bits ->
- decode_binary(<<Result0/bits,Bits:6>>, T0)
- end;
-decode_binary(Result, <<>>) ->
- true = is_binary(Result),
- Result.
+ mime_decode_list_to_string(List).
%% Skipping pad character if not at end of string. Also liberal about
%% excess padding and skipping of other illegal (non-base64 alphabet)
%% characters. See section 3.3 of RFC4648
-mime_decode_binary(Result, <<0:8,T/bits>>) ->
- mime_decode_binary(Result, T);
-mime_decode_binary(Result0, <<C:8,T/bits>>) ->
- case element(C, ?DECODE_MAP) of
- Bits when is_integer(Bits) ->
- mime_decode_binary(<<Result0/bits,Bits:6>>, T);
+mime_decode_list([0 | Cs], A) ->
+ mime_decode_list(Cs, A);
+mime_decode_list([C1 | Cs], A) ->
+ case b64d(C1) of
+ B1 when is_integer(B1) -> mime_decode_list(Cs, A, B1);
+ _ -> mime_decode_list(Cs, A) % eq is padding
+ end;
+mime_decode_list([], A) ->
+ A.
+
+mime_decode_list([0 | Cs], A, B1) ->
+ mime_decode_list(Cs, A, B1);
+mime_decode_list([C2 | Cs], A, B1) ->
+ case b64d(C2) of
+ B2 when is_integer(B2) ->
+ mime_decode_list(Cs, A, B1, B2);
+ _ -> mime_decode_list(Cs, A, B1) % eq is padding
+ end.
+
+mime_decode_list([0 | Cs], A, B1, B2) ->
+ mime_decode_list(Cs, A, B1, B2);
+mime_decode_list([C3 | Cs], A, B1, B2) ->
+ case b64d(C3) of
+ B3 when is_integer(B3) ->
+ mime_decode_list(Cs, A, B1, B2, B3);
+ eq=B3 ->
+ mime_decode_list_after_eq(Cs, A, B1, B2, B3);
+ _ -> mime_decode_list(Cs, A, B1, B2)
+ end.
+
+mime_decode_list([0 | Cs], A, B1, B2, B3) ->
+ mime_decode_list(Cs, A, B1, B2, B3);
+mime_decode_list([C4 | Cs], A, B1, B2, B3) ->
+ case b64d(C4) of
+ B4 when is_integer(B4) ->
+ mime_decode_list(Cs, <<A/bits,B1:6,B2:6,B3:6,B4:6>>);
eq ->
- mime_decode_binary_after_eq(Result0, T, false);
- _ ->
- mime_decode_binary(Result0, T)
+ mime_decode_list_after_eq(Cs, A, B1, B2, B3);
+ _ -> mime_decode_list(Cs, A, B1, B2, B3)
+ end.
+
+mime_decode_list_after_eq([0 | Cs], A, B1, B2, B3) ->
+ mime_decode_list_after_eq(Cs, A, B1, B2, B3);
+mime_decode_list_after_eq([C | Cs], A, B1, B2, B3) ->
+ case b64d(C) of
+ B when is_integer(B) ->
+ %% More valid data, skip the eq as invalid
+ case B3 of
+ eq -> mime_decode_list(Cs, A, B1, B2, B);
+ _ -> mime_decode_list(Cs, <<A/bits,B1:6,B2:6,B3:6,B:6>>)
+ end;
+ _ -> mime_decode_list_after_eq(Cs, A, B1, B2, B3)
end;
-mime_decode_binary(Result, _) ->
- true = is_binary(Result),
- Result.
-
-mime_decode_binary_after_eq(Result, <<0:8,T/bits>>, Eq) ->
- mime_decode_binary_after_eq(Result, T, Eq);
-mime_decode_binary_after_eq(Result0, <<C:8,T/bits>>, Eq) ->
- case element(C, ?DECODE_MAP) of
- bad ->
- mime_decode_binary_after_eq(Result0, T, Eq);
- ws ->
- mime_decode_binary_after_eq(Result0, T, Eq);
+mime_decode_list_after_eq([], A, B1, B2, eq) ->
+ <<A/bits,B1:6,(B2 bsr 4):2>>;
+mime_decode_list_after_eq([], A, B1, B2, B3) ->
+ <<A/bits,B1:6,B2:6,(B3 bsr 2):4>>.
+
+mime_decode_binary(<<0:8, Cs/bits>>, A) ->
+ mime_decode_binary(Cs, A);
+mime_decode_binary(<<C1:8, Cs/bits>>, A) ->
+ case b64d(C1) of
+ B1 when is_integer(B1) -> mime_decode_binary(Cs, A, B1);
+ _ -> mime_decode_binary(Cs, A) % eq is padding
+ end;
+mime_decode_binary(<<>>, A) ->
+ A.
+
+mime_decode_binary(<<0:8, Cs/bits>>, A, B1) ->
+ mime_decode_binary(Cs, A, B1);
+mime_decode_binary(<<C2:8, Cs/bits>>, A, B1) ->
+ case b64d(C2) of
+ B2 when is_integer(B2) ->
+ mime_decode_binary(Cs, A, B1, B2);
+ _ -> mime_decode_binary(Cs, A, B1) % eq is padding
+ end.
+
+mime_decode_binary(<<0:8, Cs/bits>>, A, B1, B2) ->
+ mime_decode_binary(Cs, A, B1, B2);
+mime_decode_binary(<<C3:8, Cs/bits>>, A, B1, B2) ->
+ case b64d(C3) of
+ B3 when is_integer(B3) ->
+ mime_decode_binary(Cs, A, B1, B2, B3);
+ eq=B3 ->
+ mime_decode_binary_after_eq(Cs, A, B1, B2, B3);
+ _ -> mime_decode_binary(Cs, A, B1, B2)
+ end.
+
+mime_decode_binary(<<0:8, Cs/bits>>, A, B1, B2, B3) ->
+ mime_decode_binary(Cs, A, B1, B2, B3);
+mime_decode_binary(<<C4:8, Cs/bits>>, A, B1, B2, B3) ->
+ case b64d(C4) of
+ B4 when is_integer(B4) ->
+ mime_decode_binary(Cs, <<A/bits,B1:6,B2:6,B3:6,B4:6>>);
eq ->
- mime_decode_binary_after_eq(Result0, T, true);
- Bits when is_integer(Bits) ->
+ mime_decode_binary_after_eq(Cs, A, B1, B2, B3);
+ _ -> mime_decode_binary(Cs, A, B1, B2, B3)
+ end.
+
+mime_decode_binary_after_eq(<<0:8, Cs/bits>>, A, B1, B2, B3) ->
+ mime_decode_binary_after_eq(Cs, A, B1, B2, B3);
+mime_decode_binary_after_eq(<<C:8, Cs/bits>>, A, B1, B2, B3) ->
+ case b64d(C) of
+ B when is_integer(B) ->
%% More valid data, skip the eq as invalid
- mime_decode_binary(<<Result0/bits,Bits:6>>, T)
+ case B3 of
+ eq -> mime_decode_binary(Cs, A, B1, B2, B);
+ _ -> mime_decode_binary(Cs, <<A/bits,B1:6,B2:6,B3:6,B:6>>)
+ end;
+ _ -> mime_decode_binary_after_eq(Cs, A, B1, B2, B3)
+ end;
+mime_decode_binary_after_eq(<<>>, A, B1, B2, eq) ->
+ <<A/bits,B1:6,(B2 bsr 4):2>>;
+mime_decode_binary_after_eq(<<>>, A, B1, B2, B3) ->
+ <<A/bits,B1:6,B2:6,(B3 bsr 2):4>>.
+
+mime_decode_list_to_string([0 | Cs]) ->
+ mime_decode_list_to_string(Cs);
+mime_decode_list_to_string([C1 | Cs]) ->
+ case b64d(C1) of
+ B1 when is_integer(B1) -> mime_decode_list_to_string(Cs, B1);
+ _ -> mime_decode_list_to_string(Cs) % eq is padding
end;
-mime_decode_binary_after_eq(Result0, <<>>, Eq) ->
- %% No more valid data.
- case bit_size(Result0) rem 8 of
- 0 ->
- %% '====' is not uncommon.
- Result0;
- 4 when Eq ->
- %% enforce at least one more '=' only ignoring illegals and spacing
- Split = byte_size(Result0) - 1,
- <<Result:Split/bytes,_:4>> = Result0,
- Result;
- 2 ->
- %% remove 2 bits
- Split = byte_size(Result0) - 1,
- <<Result:Split/bytes,_:2>> = Result0,
- Result
+mime_decode_list_to_string([]) ->
+ [].
+
+mime_decode_list_to_string([0 | Cs], B1) ->
+ mime_decode_list_to_string(Cs, B1);
+mime_decode_list_to_string([C2 | Cs], B1) ->
+ case b64d(C2) of
+ B2 when is_integer(B2) ->
+ mime_decode_list_to_string(Cs, B1, B2);
+ _ -> mime_decode_list_to_string(Cs, B1) % eq is padding
end.
-decode([], A) -> A;
-decode([$=,$=,C2,C1|Cs], A) ->
- Bits2x6 = (b64d(C1) bsl 18) bor (b64d(C2) bsl 12),
- Octet1 = Bits2x6 bsr 16,
- decode(Cs, [Octet1|A]);
-decode([$=,C3,C2,C1|Cs], A) ->
- Bits3x6 = (b64d(C1) bsl 18) bor (b64d(C2) bsl 12)
- bor (b64d(C3) bsl 6),
- Octet1 = Bits3x6 bsr 16,
- Octet2 = (Bits3x6 bsr 8) band 16#ff,
- decode(Cs, [Octet1,Octet2|A]);
-decode([C4,C3,C2,C1| Cs], A) ->
- Bits4x6 = (b64d(C1) bsl 18) bor (b64d(C2) bsl 12)
- bor (b64d(C3) bsl 6) bor b64d(C4),
- Octet1 = Bits4x6 bsr 16,
- Octet2 = (Bits4x6 bsr 8) band 16#ff,
- Octet3 = Bits4x6 band 16#ff,
- decode(Cs, [Octet1,Octet2,Octet3|A]).
+mime_decode_list_to_string([0 | Cs], B1, B2) ->
+ mime_decode_list_to_string(Cs, B1, B2);
+mime_decode_list_to_string([C3 | Cs], B1, B2) ->
+ case b64d(C3) of
+ B3 when is_integer(B3) ->
+ mime_decode_list_to_string(Cs, B1, B2, B3);
+ eq=B3 -> mime_decode_list_to_string_after_eq(Cs, B1, B2, B3);
+ _ -> mime_decode_list_to_string(Cs, B1, B2)
+ end.
-%%%========================================================================
-%%% Internal functions
-%%%========================================================================
+mime_decode_list_to_string([0 | Cs], B1, B2, B3) ->
+ mime_decode_list_to_string(Cs, B1, B2, B3);
+mime_decode_list_to_string([C4 | Cs], B1, B2, B3) ->
+ case b64d(C4) of
+ B4 when is_integer(B4) ->
+ Bits4x6 = (B1 bsl 18) bor (B2 bsl 12) bor (B3 bsl 6) bor B4,
+ Octet1 = Bits4x6 bsr 16,
+ Octet2 = (Bits4x6 bsr 8) band 16#ff,
+ Octet3 = Bits4x6 band 16#ff,
+ [Octet1, Octet2, Octet3 | mime_decode_list_to_string(Cs)];
+ eq ->
+ mime_decode_list_to_string_after_eq(Cs, B1, B2, B3);
+ _ -> mime_decode_list_to_string(Cs, B1, B2, B3)
+ end.
-strip_spaces([], A) -> A;
-strip_spaces([$\s|Cs], A) -> strip_spaces(Cs, A);
-strip_spaces([$\t|Cs], A) -> strip_spaces(Cs, A);
-strip_spaces([$\r|Cs], A) -> strip_spaces(Cs, A);
-strip_spaces([$\n|Cs], A) -> strip_spaces(Cs, A);
-strip_spaces([C|Cs], A) -> strip_spaces(Cs, [C | A]).
-
-strip_ws(<<$\t,T/binary>>) ->
- strip_ws(T);
-strip_ws(<<$\n,T/binary>>) ->
- strip_ws(T);
-strip_ws(<<$\r,T/binary>>) ->
- strip_ws(T);
-strip_ws(<<$\s,T/binary>>) ->
- strip_ws(T);
-strip_ws(T) -> T.
+mime_decode_list_to_string_after_eq([0 | Cs], B1, B2, B3) ->
+ mime_decode_list_to_string_after_eq(Cs, B1, B2, B3);
+mime_decode_list_to_string_after_eq([C | Cs], B1, B2, B3) ->
+ case b64d(C) of
+ B when is_integer(B) ->
+ %% More valid data, skip the eq as invalid
+ case B3 of
+ eq -> mime_decode_list_to_string(Cs, B1, B2, B);
+ _ ->
+ Bits4x6 = (B1 bsl 18) bor (B2 bsl 12) bor (B3 bsl 6) bor B,
+ Octet1 = Bits4x6 bsr 16,
+ Octet2 = (Bits4x6 bsr 8) band 16#ff,
+ Octet3 = Bits4x6 band 16#ff,
+ [Octet1, Octet2, Octet3 | mime_decode_list_to_string(Cs)]
+ end;
+ _ -> mime_decode_list_to_string_after_eq(Cs, B1, B2, B3)
+ end;
+mime_decode_list_to_string_after_eq([], B1, B2, eq) ->
+ binary_to_list(<<B1:6,(B2 bsr 4):2>>);
+mime_decode_list_to_string_after_eq([], B1, B2, B3) ->
+ binary_to_list(<<B1:6,B2:6,(B3 bsr 2):4>>).
+
+decode_list([C1 | Cs], A) ->
+ case b64d(C1) of
+ ws -> decode_list(Cs, A);
+ B1 -> decode_list(Cs, A, B1)
+ end;
+decode_list([], A) ->
+ A.
-%% Skipping pad character if not at end of string. Also liberal about
-%% excess padding and skipping of other illegal (non-base64 alphabet)
-%% characters. See section 3.3 of RFC4648
-strip_illegal([], A, _Cnt) ->
+decode_list([C2 | Cs], A, B1) ->
+ case b64d(C2) of
+ ws -> decode_list(Cs, A, B1);
+ B2 -> decode_list(Cs, A, B1, B2)
+ end.
+
+decode_list([C3 | Cs], A, B1, B2) ->
+ case b64d(C3) of
+ ws -> decode_list(Cs, A, B1, B2);
+ B3 -> decode_list(Cs, A, B1, B2, B3)
+ end.
+
+decode_list([C4 | Cs], A, B1, B2, B3) ->
+ case b64d(C4) of
+ ws -> decode_list(Cs, A, B1, B2, B3);
+ eq when B3 =:= eq -> only_ws(Cs, <<A/bits,B1:6,(B2 bsr 4):2>>);
+ eq -> only_ws(Cs, <<A/bits,B1:6,B2:6,(B3 bsr 2):4>>);
+ B4 -> decode_list(Cs, <<A/bits,B1:6,B2:6,B3:6,B4:6>>)
+ end.
+
+decode_binary(<<C1:8, Cs/bits>>, A) ->
+ case b64d(C1) of
+ ws -> decode_binary(Cs, A);
+ B1 -> decode_binary(Cs, A, B1)
+ end;
+decode_binary(<<>>, A) ->
+ A.
+
+decode_binary(<<C2:8, Cs/bits>>, A, B1) ->
+ case b64d(C2) of
+ ws -> decode_binary(Cs, A, B1);
+ B2 -> decode_binary(Cs, A, B1, B2)
+ end.
+
+decode_binary(<<C3:8, Cs/bits>>, A, B1, B2) ->
+ case b64d(C3) of
+ ws -> decode_binary(Cs, A, B1, B2);
+ B3 -> decode_binary(Cs, A, B1, B2, B3)
+ end.
+
+decode_binary(<<C4:8, Cs/bits>>, A, B1, B2, B3) ->
+ case b64d(C4) of
+ ws -> decode_binary(Cs, A, B1, B2, B3);
+ eq when B3 =:= eq -> only_ws_binary(Cs, <<A/bits,B1:6,(B2 bsr 4):2>>);
+ eq -> only_ws_binary(Cs, <<A/bits,B1:6,B2:6,(B3 bsr 2):4>>);
+ B4 -> decode_binary(Cs, <<A/bits,B1:6,B2:6,B3:6,B4:6>>)
+ end.
+
+only_ws_binary(<<>>, A) ->
A;
-strip_illegal([0|Cs], A, Cnt) ->
- strip_illegal(Cs, A, Cnt);
-strip_illegal([C|Cs], A, Cnt) ->
- case element(C, ?DECODE_MAP) of
- bad ->
- strip_illegal(Cs, A, Cnt);
- ws ->
- strip_illegal(Cs, A, Cnt);
- eq ->
- case {tail_contains_more(Cs, false), Cnt rem 4} of
- {{[], _}, 0} ->
- A; %% Ignore extra =
- {{[], true}, 2} ->
- [$=|[$=|A]]; %% 'XX=='
- {{[], _}, 3} ->
- [$=|A]; %% 'XXX='
- {{[H|T], _}, _} ->
- %% more data, skip equals
- strip_illegal(T, [H|A], Cnt+1)
- end;
- _ ->
- strip_illegal(Cs, [C|A], Cnt+1)
+only_ws_binary(<<C:8, Cs/bits>>, A) ->
+ case b64d(C) of
+ ws -> only_ws_binary(Cs, A)
end.
-%% Search the tail for more valid data and remember if we saw
-%% another equals along the way.
-tail_contains_more([], Eq) ->
- {[], Eq};
-tail_contains_more(<<>>, Eq) ->
- {<<>>, Eq};
-tail_contains_more([C|T]=More, Eq) ->
- case element(C, ?DECODE_MAP) of
- bad ->
- tail_contains_more(T, Eq);
- ws ->
- tail_contains_more(T, Eq);
- eq ->
- tail_contains_more(T, true);
- _ ->
- {More, Eq}
+decode_list_to_string([C1 | Cs]) ->
+ case b64d(C1) of
+ ws -> decode_list_to_string(Cs);
+ B1 -> decode_list_to_string(Cs, B1)
end;
-tail_contains_more(<<C:8,T/bits>> =More, Eq) ->
- case element(C, ?DECODE_MAP) of
- bad ->
- tail_contains_more(T, Eq);
- ws ->
- tail_contains_more(T, Eq);
- eq ->
- tail_contains_more(T, true);
- _ ->
- {More, Eq}
+decode_list_to_string([]) ->
+ [].
+
+decode_list_to_string([C2 | Cs], B1) ->
+ case b64d(C2) of
+ ws -> decode_list_to_string(Cs, B1);
+ B2 -> decode_list_to_string(Cs, B1, B2)
end.
-
+
+decode_list_to_string([C3 | Cs], B1, B2) ->
+ case b64d(C3) of
+ ws -> decode_list_to_string(Cs, B1, B2);
+ B3 -> decode_list_to_string(Cs, B1, B2, B3)
+ end.
+
+decode_list_to_string([C4 | Cs], B1, B2, B3) ->
+ case b64d(C4) of
+ ws ->
+ decode_list_to_string(Cs, B1, B2, B3);
+ eq when B3 =:= eq ->
+ only_ws(Cs, binary_to_list(<<B1:6,(B2 bsr 4):2>>));
+ eq ->
+ only_ws(Cs, binary_to_list(<<B1:6,B2:6,(B3 bsr 2):4>>));
+ B4 ->
+ Bits4x6 = (B1 bsl 18) bor (B2 bsl 12) bor (B3 bsl 6) bor B4,
+ Octet1 = Bits4x6 bsr 16,
+ Octet2 = (Bits4x6 bsr 8) band 16#ff,
+ Octet3 = Bits4x6 band 16#ff,
+ [Octet1, Octet2, Octet3 | decode_list_to_string(Cs)]
+ end.
+
+only_ws([], A) ->
+ A;
+only_ws([C | Cs], A) ->
+ case b64d(C) of
+ ws -> only_ws(Cs, A)
+ end.
+
+%%%========================================================================
+%%% Internal functions
+%%%========================================================================
+
%% accessors
+-compile({inline, [{b64d, 1}]}).
+%% One-based decode map.
+b64d(X) ->
+ element(X,
+ {bad,bad,bad,bad,bad,bad,bad,bad,ws,ws,bad,bad,ws,bad,bad, %1-15
+ bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad, %16-31
+ ws,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,62,bad,bad,bad,63, %32-47
+ 52,53,54,55,56,57,58,59,60,61,bad,bad,bad,eq,bad,bad, %48-63
+ bad,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,
+ 15,16,17,18,19,20,21,22,23,24,25,bad,bad,bad,bad,bad,
+ bad,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,
+ 41,42,43,44,45,46,47,48,49,50,51,bad,bad,bad,bad,bad,
+ bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,
+ bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,
+ bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,
+ bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,
+ bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,
+ bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,
+ bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,
+ bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad}).
+
+-compile({inline, [{b64e, 1}]}).
b64e(X) ->
element(X+1,
{$A, $B, $C, $D, $E, $F, $G, $H, $I, $J, $K, $L, $M, $N,
@@ -368,9 +463,3 @@ b64e(X) ->
$a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $k, $l, $m, $n,
$o, $p, $q, $r, $s, $t, $u, $v, $w, $x, $y, $z,
$0, $1, $2, $3, $4, $5, $6, $7, $8, $9, $+, $/}).
-
-
-b64d(X) ->
- b64d_ok(element(X, ?DECODE_MAP)).
-
-b64d_ok(I) when is_integer(I) -> I.
diff --git a/lib/stdlib/src/beam_lib.erl b/lib/stdlib/src/beam_lib.erl
index 06c15fceda..3386cfcbe6 100644
--- a/lib/stdlib/src/beam_lib.erl
+++ b/lib/stdlib/src/beam_lib.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2000-2017. All Rights Reserved.
+%% Copyright Ericsson AB 2000-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -53,7 +53,7 @@
%%-------------------------------------------------------------------------
--type beam() :: module() | file:filename() | binary().
+-type beam() :: file:filename() | binary().
-type debug_info() :: {DbgiVersion :: atom(), Backend :: module(), Data :: term()} | 'no_debug_info'.
-type forms() :: [erl_parse:abstract_form() | erl_parse:form_info()].
@@ -148,7 +148,8 @@ chunks(File, Chunks, Options) ->
try read_chunk_data(File, Chunks, Options)
catch Error -> Error end.
--spec all_chunks(beam()) -> {'ok', 'beam_lib', [{chunkid(), dataB()}]}.
+-spec all_chunks(beam()) ->
+ {'ok', 'beam_lib', [{chunkid(), dataB()}]} | {'error', 'beam_lib', info_rsn()}.
all_chunks(File) ->
read_all_chunks(File).
@@ -689,30 +690,31 @@ chunk_to_data(debug_info=Id, Chunk, File, _Cs, AtomTable, Mod) ->
<<0:8,N:8,Mode0:N/binary,Rest/binary>> ->
Mode = binary_to_atom(Mode0, utf8),
Term = decrypt_chunk(Mode, Mod, File, Id, Rest),
- {AtomTable, {Id, Term}};
+ {AtomTable, {Id, anno_from_term(Term)}};
_ ->
case catch binary_to_term(Chunk) of
{'EXIT', _} ->
error({invalid_chunk, File, chunk_name_to_id(Id, File)});
Term ->
- {AtomTable, {Id, Term}}
+ {AtomTable, {Id, anno_from_term(Term)}}
end
end;
chunk_to_data(abstract_code=Id, Chunk, File, _Cs, AtomTable, Mod) ->
+ %% Before Erlang/OTP 20.0.
case Chunk of
<<>> ->
{AtomTable, {Id, no_abstract_code}};
<<0:8,N:8,Mode0:N/binary,Rest/binary>> ->
Mode = binary_to_atom(Mode0, utf8),
Term = decrypt_chunk(Mode, Mod, File, Id, Rest),
- {AtomTable, {Id, anno_from_term(Term)}};
+ {AtomTable, {Id, old_anno_from_term(Term)}};
_ ->
case catch binary_to_term(Chunk) of
{'EXIT', _} ->
error({invalid_chunk, File, chunk_name_to_id(Id, File)});
Term ->
try
- {AtomTable, {Id, anno_from_term(Term)}}
+ {AtomTable, {Id, old_anno_from_term(Term)}}
catch
_:_ ->
error({invalid_chunk, File,
@@ -946,14 +948,24 @@ decrypt_chunk(Type, Module, File, Id, Bin) ->
error({key_missing_or_invalid, File, Id})
end.
-anno_from_term({raw_abstract_v1, Forms}) ->
+old_anno_from_term({raw_abstract_v1, Forms}) ->
{raw_abstract_v1, anno_from_forms(Forms)};
-anno_from_term({Tag, Forms}) when Tag =:= abstract_v1; Tag =:= abstract_v2 ->
+old_anno_from_term({Tag, Forms}) when Tag =:= abstract_v1;
+ Tag =:= abstract_v2 ->
try {Tag, anno_from_forms(Forms)}
catch
_:_ ->
{Tag, Forms}
end;
+old_anno_from_term(T) ->
+ T.
+
+anno_from_term({debug_info_v1=Tag1, erl_abstract_code=Tag2, {Forms, Opts}}) ->
+ try {Tag1, Tag2, {anno_from_forms(Forms), Opts}}
+ catch
+ _:_ ->
+ {Tag1, Tag2, {Forms, Opts}}
+ end;
anno_from_term(T) ->
T.
diff --git a/lib/stdlib/src/binary.erl b/lib/stdlib/src/binary.erl
index 6a64133b45..52b9fedc9c 100644
--- a/lib/stdlib/src/binary.erl
+++ b/lib/stdlib/src/binary.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2017. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -47,23 +47,39 @@ at(_, _) ->
-spec bin_to_list(Subject) -> [byte()] when
Subject :: binary().
-bin_to_list(_) ->
- erlang:nif_error(undef).
+bin_to_list(Subject) ->
+ binary_to_list(Subject).
-spec bin_to_list(Subject, PosLen) -> [byte()] when
Subject :: binary(),
PosLen :: part().
-bin_to_list(_, _) ->
- erlang:nif_error(undef).
+bin_to_list(Subject, {Pos, Len}) ->
+ bin_to_list(Subject, Pos, Len);
+bin_to_list(_Subject, _BadArg) ->
+ erlang:error(badarg).
-spec bin_to_list(Subject, Pos, Len) -> [byte()] when
Subject :: binary(),
Pos :: non_neg_integer(),
Len :: integer().
-bin_to_list(_, _, _) ->
- erlang:nif_error(undef).
+bin_to_list(Subject, Pos, Len) when not is_binary(Subject);
+ not is_integer(Pos);
+ not is_integer(Len) ->
+ %% binary_to_list/3 allows bitstrings as long as the slice fits, and we
+ %% want to badarg when Pos/Len aren't integers instead of raising badarith
+ %% when adjusting args for binary_to_list/3.
+ erlang:error(badarg);
+bin_to_list(Subject, Pos, 0) when Pos >= 0, Pos =< byte_size(Subject) ->
+ %% binary_to_list/3 doesn't handle this case.
+ [];
+bin_to_list(_Subject, _Pos, 0) ->
+ erlang:error(badarg);
+bin_to_list(Subject, Pos, Len) when Len < 0 ->
+ bin_to_list(Subject, Pos + Len, -Len);
+bin_to_list(Subject, Pos, Len) when Len > 0 ->
+ binary_to_list(Subject, Pos + 1, Pos + Len).
-spec compile_pattern(Pattern) -> cp() when
Pattern :: binary() | [binary()].
diff --git a/lib/stdlib/src/c.erl b/lib/stdlib/src/c.erl
index c04a201ce1..0362b72536 100644
--- a/lib/stdlib/src/c.erl
+++ b/lib/stdlib/src/c.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -564,7 +564,7 @@ display_info(Pid) ->
Other
end,
Reds = fetch(reductions, Info),
- LM = length(fetch(messages, Info)),
+ LM = fetch(message_queue_len, Info),
HS = fetch(heap_size, Info),
SS = fetch(stack_size, Info),
iformat(w(Pid), mfa_string(Call),
@@ -668,19 +668,23 @@ lm() ->
[l(M) || M <- mm()].
%% erlangrc(Home)
-%% Try to run a ".erlang" file, first in the current directory
-%% else in home directory.
+%% Try to run a ".erlang" file in home directory.
+
+-spec erlangrc() -> {ok, file:filename()} | {error, term()}.
erlangrc() ->
case init:get_argument(home) of
{ok,[[Home]]} ->
erlangrc([Home]);
_ ->
- f_p_e(["."], ".erlang")
+ {error, enoent}
end.
-erlangrc([Home]) ->
- f_p_e([".",Home], ".erlang").
+-spec erlangrc(PathList) -> {ok, file:filename()} | {error, term()}
+ when PathList :: [Dir :: file:name()].
+
+erlangrc([Home|_]=Paths) when is_list(Home) ->
+ f_p_e(Paths, ".erlang").
error(Fmt, Args) ->
error_logger:error_msg(Fmt, Args).
@@ -692,11 +696,11 @@ f_p_e(P, F) ->
{error, E={Line, _Mod, _Term}} ->
error("file:path_eval(~tp,~tp): error on line ~p: ~ts~n",
[P, F, Line, file:format_error(E)]),
- ok;
+ {error, E};
{error, E} ->
error("file:path_eval(~tp,~tp): ~ts~n",
[P, F, file:format_error(E)]),
- ok;
+ {error, E};
Other ->
Other
end.
@@ -882,7 +886,7 @@ portinfo(Id) ->
procline(Name, Info, Pid) ->
Call = initial_call(Info),
Reds = fetch(reductions, Info),
- LM = length(fetch(messages, Info)),
+ LM = fetch(message_queue_len, Info),
procformat(io_lib:format("~tw",[Name]),
io_lib:format("~w",[Pid]),
io_lib:format("~ts",[mfa_string(Call)]),
@@ -1030,8 +1034,8 @@ appcall(App, M, F, Args) ->
try
apply(M, F, Args)
catch
- error:undef ->
- case erlang:get_stacktrace() of
+ error:undef:S ->
+ case S of
[{M,F,Args,_}|_] ->
Arity = length(Args),
io:format("Call to ~w:~w/~w in application ~w failed.\n",
diff --git a/lib/stdlib/src/calendar.erl b/lib/stdlib/src/calendar.erl
index 55a0cfc9a1..9a600c1972 100644
--- a/lib/stdlib/src/calendar.erl
+++ b/lib/stdlib/src/calendar.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -39,8 +39,14 @@
now_to_datetime/1, % = now_to_universal_time/1
now_to_local_time/1,
now_to_universal_time/1,
+ rfc3339_to_system_time/1,
+ rfc3339_to_system_time/2,
seconds_to_daystime/1,
seconds_to_time/1,
+ system_time_to_local_time/2,
+ system_time_to_universal_time/2,
+ system_time_to_rfc3339/1,
+ system_time_to_rfc3339/2,
time_difference/2,
time_to_seconds/1,
universal_time/0,
@@ -55,10 +61,13 @@
-define(SECONDS_PER_DAY, 86400).
-define(DAYS_PER_YEAR, 365).
-define(DAYS_PER_LEAP_YEAR, 366).
--define(DAYS_PER_4YEARS, 1461).
--define(DAYS_PER_100YEARS, 36524).
--define(DAYS_PER_400YEARS, 146097).
+%% -define(DAYS_PER_4YEARS, 1461).
+%% -define(DAYS_PER_100YEARS, 36524).
+%% -define(DAYS_PER_400YEARS, 146097).
-define(DAYS_FROM_0_TO_1970, 719528).
+-define(DAYS_FROM_0_TO_10000, 2932897).
+-define(SECONDS_FROM_0_TO_1970, (?DAYS_FROM_0_TO_1970*?SECONDS_PER_DAY)).
+-define(SECONDS_FROM_0_TO_10000, (?DAYS_FROM_0_TO_10000*?SECONDS_PER_DAY)).
%%----------------------------------------------------------------------
%% Types
@@ -83,6 +92,13 @@
-type datetime1970() :: {{year1970(),month(),day()},time()}.
-type yearweeknum() :: {year(),weeknum()}.
+-type rfc3339_string() :: [byte(), ...].
+%% By design 'native' is not supported:
+-type rfc3339_time_unit() :: 'microsecond'
+ | 'millisecond'
+ | 'nanosecond'
+ | 'second'.
+
%%----------------------------------------------------------------------
%% All dates are according the the Gregorian calendar. In this module
@@ -309,8 +325,7 @@ local_time_to_universal_time_dst(DateTime) ->
-spec now_to_datetime(Now) -> datetime1970() when
Now :: erlang:timestamp().
now_to_datetime({MSec, Sec, _uSec}) ->
- Sec0 = MSec*1000000 + Sec + ?DAYS_FROM_0_TO_1970*?SECONDS_PER_DAY,
- gregorian_seconds_to_datetime(Sec0).
+ system_time_to_datetime(MSec*1000000 + Sec).
-spec now_to_universal_time(Now) -> datetime1970() when
Now :: erlang:timestamp().
@@ -328,6 +343,33 @@ now_to_local_time({MSec, Sec, _uSec}) ->
erlang:universaltime_to_localtime(
now_to_universal_time({MSec, Sec, _uSec})).
+-spec rfc3339_to_system_time(DateTimeString) -> integer() when
+ DateTimeString :: rfc3339_string().
+
+rfc3339_to_system_time(DateTimeString) ->
+ rfc3339_to_system_time(DateTimeString, []).
+
+-spec rfc3339_to_system_time(DateTimeString, Options) -> integer() when
+ DateTimeString :: rfc3339_string(),
+ Options :: [Option],
+ Option :: {'unit', rfc3339_time_unit()}.
+
+rfc3339_to_system_time(DateTimeString, Options) ->
+ Unit = proplists:get_value(unit, Options, second),
+ %% _T is the character separating the date and the time:
+ {DateStr, [_T|TimeStr]} = lists:split(10, DateTimeString),
+ {TimeStr2, TimeStr3} = lists:split(8, TimeStr),
+ {ok, [Hour, Min, Sec], []} = io_lib:fread("~d:~d:~d", TimeStr2),
+ {ok, [Year, Month, Day], []} = io_lib:fread("~d-~d-~d", DateStr),
+ DateTime = {{Year, Month, Day}, {Hour, Min, Sec}},
+ IsFractionChar = fun(C) -> C >= $0 andalso C =< $9 orelse C =:= $. end,
+ {FractionStr, UtcOffset} = lists:splitwith(IsFractionChar, TimeStr3),
+ Time = datetime_to_system_time(DateTime),
+ Secs = Time - offset_adjustment(Time, second, UtcOffset),
+ check(DateTimeString, Options, Secs),
+ ScaledEpoch = erlang:convert_time_unit(Secs, second, Unit),
+ ScaledEpoch + copy_sign(fraction(Unit, FractionStr), ScaledEpoch).
+
%% seconds_to_daystime(Secs) = {Days, {Hour, Minute, Second}}
@@ -363,6 +405,55 @@ seconds_to_time(Secs) when Secs >= 0, Secs < ?SECONDS_PER_DAY ->
Second = Secs1 rem ?SECONDS_PER_MINUTE,
{Hour, Minute, Second}.
+-spec system_time_to_local_time(Time, TimeUnit) -> datetime() when
+ Time :: integer(),
+ TimeUnit :: erlang:time_unit().
+
+system_time_to_local_time(Time, TimeUnit) ->
+ UniversalDate = system_time_to_universal_time(Time, TimeUnit),
+ erlang:universaltime_to_localtime(UniversalDate).
+
+-spec system_time_to_universal_time(Time, TimeUnit) -> datetime() when
+ Time :: integer(),
+ TimeUnit :: erlang:time_unit().
+
+system_time_to_universal_time(Time, TimeUnit) ->
+ Secs = erlang:convert_time_unit(Time, TimeUnit, second),
+ system_time_to_datetime(Secs).
+
+-spec system_time_to_rfc3339(Time) -> DateTimeString when
+ Time :: integer(),
+ DateTimeString :: rfc3339_string().
+
+system_time_to_rfc3339(Time) ->
+ system_time_to_rfc3339(Time, []).
+
+-type offset() :: [byte()] | (Time :: integer()).
+-spec system_time_to_rfc3339(Time, Options) -> DateTimeString when
+ Time :: integer(), % Since Epoch
+ Options :: [Option],
+ Option :: {'offset', offset()}
+ | {'time_designator', byte()}
+ | {'unit', rfc3339_time_unit()},
+ DateTimeString :: rfc3339_string().
+
+system_time_to_rfc3339(Time, Options) ->
+ Unit = proplists:get_value(unit, Options, second),
+ OffsetOption = proplists:get_value(offset, Options, ""),
+ T = proplists:get_value(time_designator, Options, $T),
+ AdjustmentSecs = offset_adjustment(Time, Unit, OffsetOption),
+ Offset = offset(OffsetOption, AdjustmentSecs),
+ Adjustment = erlang:convert_time_unit(AdjustmentSecs, second, Unit),
+ AdjustedTime = Time + Adjustment,
+ Factor = factor(Unit),
+ Secs = AdjustedTime div Factor,
+ check(Time, Options, Secs),
+ DateTime = system_time_to_datetime(Secs),
+ {{Year, Month, Day}, {Hour, Min, Sec}} = DateTime,
+ FractionStr = fraction_str(Factor, AdjustedTime),
+ flat_fwrite("~4.10.0B-~2.10.0B-~2.10.0B~c~2.10.0B:~2.10.0B:~2.10.0B~s~s",
+ [Year, Month, Day, T, Hour, Min, Sec, FractionStr, Offset]).
+
%% time_difference(T1, T2) = Tdiff
%%
%% Returns the difference between two {Date, Time} structures.
@@ -550,3 +641,85 @@ df(Year, _) ->
true -> 1;
false -> 0
end.
+
+check(_Arg, _Options, Secs) when Secs >= - ?SECONDS_FROM_0_TO_1970,
+ Secs < ?SECONDS_FROM_0_TO_10000 ->
+ ok;
+check(Arg, Options, _Secs) ->
+ erlang:error({badarg, [Arg, Options]}).
+
+datetime_to_system_time(DateTime) ->
+ datetime_to_gregorian_seconds(DateTime) - ?SECONDS_FROM_0_TO_1970.
+
+system_time_to_datetime(Seconds) ->
+ gregorian_seconds_to_datetime(Seconds + ?SECONDS_FROM_0_TO_1970).
+
+offset(OffsetOption, Secs0) when OffsetOption =:= "";
+ is_integer(OffsetOption) ->
+ Sign = case Secs0 < 0 of
+ true -> $-;
+ false -> $+
+ end,
+ Secs = abs(Secs0),
+ Hour = Secs div 3600,
+ Min = (Secs rem 3600) div 60,
+ io_lib:fwrite("~c~2.10.0B:~2.10.0B", [Sign, Hour, Min]);
+offset(OffsetOption, _Secs) ->
+ OffsetOption.
+
+offset_adjustment(Time, Unit, OffsetString) when is_list(OffsetString) ->
+ offset_string_adjustment(Time, Unit, OffsetString);
+offset_adjustment(_Time, Unit, Offset) when is_integer(Offset) ->
+ erlang:convert_time_unit(Offset, Unit, second).
+
+offset_string_adjustment(Time, Unit, "") ->
+ local_offset(Time, Unit);
+offset_string_adjustment(_Time, _Unit, "Z") ->
+ 0;
+offset_string_adjustment(_Time, _Unit, "z") ->
+ 0;
+offset_string_adjustment(_Time, _Unit, [Sign|Tz]) ->
+ {ok, [Hour, Min], []} = io_lib:fread("~d:~d", Tz),
+ Adjustment = 3600 * Hour + 60 * Min,
+ case Sign of
+ $- -> -Adjustment;
+ $+ -> Adjustment
+ end.
+
+local_offset(SystemTime, Unit) ->
+ LocalTime = system_time_to_local_time(SystemTime, Unit),
+ UniversalTime = system_time_to_universal_time(SystemTime, Unit),
+ LocalSecs = datetime_to_gregorian_seconds(LocalTime),
+ UniversalSecs = datetime_to_gregorian_seconds(UniversalTime),
+ LocalSecs - UniversalSecs.
+
+fraction_str(Factor, Time) ->
+ case Time rem Factor of
+ 0 ->
+ "";
+ Fraction ->
+ FS = io_lib:fwrite(".~*..0B", [log10(Factor), abs(Fraction)]),
+ string:trim(FS, trailing, "0")
+ end.
+
+fraction(second, _) ->
+ 0;
+fraction(_, "") ->
+ 0;
+fraction(Unit, FractionStr) ->
+ round(factor(Unit) * list_to_float([$0|FractionStr])).
+
+copy_sign(N1, N2) when N2 < 0 -> -N1;
+copy_sign(N1, _N2) -> N1.
+
+factor(second) -> 1;
+factor(millisecond) -> 1000;
+factor(microsecond) -> 1000000;
+factor(nanosecond) -> 1000000000.
+
+log10(1000) -> 3;
+log10(1000000) -> 6;
+log10(1000000000) -> 9.
+
+flat_fwrite(F, S) ->
+ lists:flatten(io_lib:fwrite(F, S)).
diff --git a/lib/stdlib/src/dets.erl b/lib/stdlib/src/dets.erl
index 4e3fe0e5c1..0488c2bef2 100644
--- a/lib/stdlib/src/dets.erl
+++ b/lib/stdlib/src/dets.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -616,12 +616,18 @@ next(Tab, Key) ->
%% Assuming that a file already exists, open it with the
%% parameters as already specified in the file itself.
%% Return a ref leading to the file.
-open_file(File) ->
- case dets_server:open_file(to_list(File)) of
- badarg -> % Should not happen.
- erlang:error(dets_process_died, [File]);
- Reply ->
- einval(Reply, [File])
+open_file(File0) ->
+ File = to_list(File0),
+ case is_list(File) of
+ true ->
+ case dets_server:open_file(File) of
+ badarg -> % Should not happen.
+ erlang:error(dets_process_died, [File]);
+ Reply ->
+ einval(Reply, [File])
+ end;
+ false ->
+ erlang:error(badarg, [File0])
end.
-spec open_file(Name, Args) -> {'ok', Name} | {'error', Reason} when
@@ -1088,6 +1094,7 @@ defaults(Tab, Args) ->
debug = false},
Fun = fun repl/2,
Defaults = lists:foldl(Fun, Defaults0, Args),
+ true = is_list(Defaults#open_args.file),
is_comp_min_max(Defaults).
to_list(T) when is_atom(T) -> atom_to_list(T);
@@ -1112,9 +1119,7 @@ repl({delayed_write, {Delay,Size} = C}, Defs)
Defs#open_args{delayed_write = C};
repl({estimated_no_objects, I}, Defs) ->
repl({min_no_slots, I}, Defs);
-repl({file, File}, Defs) when is_list(File) ->
- Defs#open_args{file = File};
-repl({file, File}, Defs) when is_atom(File) ->
+repl({file, File}, Defs) ->
Defs#open_args{file = to_list(File)};
repl({keypos, P}, Defs) when is_integer(P), P > 0 ->
Defs#open_args{keypos =P};
@@ -1288,8 +1293,8 @@ init(Parent, Server) ->
catch
exit:normal ->
exit(normal);
- _:Bad ->
- bug_found(no_name, Op, Bad, From),
+ _:Bad:Stacktrace ->
+ bug_found(no_name, Op, Bad, Stacktrace, From),
exit(Bad) % give up
end
end.
@@ -1371,8 +1376,8 @@ do_apply_op(Op, From, Head, N) ->
catch
exit:normal ->
exit(normal);
- _:Bad ->
- bug_found(Head#head.name, Op, Bad, From),
+ _:Bad:Stacktrace ->
+ bug_found(Head#head.name, Op, Bad, Stacktrace, From),
open_file_loop(Head, N)
end.
@@ -1581,7 +1586,7 @@ apply_op(Op, From, Head, N) ->
ok
end.
-bug_found(Name, Op, Bad, From) ->
+bug_found(Name, Op, Bad, Stacktrace, From) ->
case dets_utils:debug_mode() of
true ->
%% If stream_op/5 found more requests, this is not
@@ -1590,7 +1595,7 @@ bug_found(Name, Op, Bad, From) ->
("** dets: Bug was found when accessing table ~tw,~n"
"** dets: operation was ~tp and reply was ~tw.~n"
"** dets: Stacktrace: ~tw~n",
- [Name, Op, Bad, erlang:get_stacktrace()]);
+ [Name, Op, Bad, Stacktrace]);
false ->
error_logger:format
("** dets: Bug was found when accessing table ~tw~n",
diff --git a/lib/stdlib/src/dets_utils.erl b/lib/stdlib/src/dets_utils.erl
index 17f55ebdc2..12394bd1ad 100644
--- a/lib/stdlib/src/dets_utils.erl
+++ b/lib/stdlib/src/dets_utils.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2001-2017. All Rights Reserved.
+%% Copyright Ericsson AB 2001-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -377,7 +377,8 @@ corrupt_reason(Head, Reason0) ->
no_disk_map ->
Reason0;
DM ->
- ST = erlang:get_stacktrace(),
+ {current_stacktrace, ST} =
+ erlang:process_info(self(), current_stacktrace),
PD = get(),
{Reason0, ST, PD, DM}
end,
diff --git a/lib/stdlib/src/edlin.erl b/lib/stdlib/src/edlin.erl
index 5df9c504f9..f027d05f55 100644
--- a/lib/stdlib/src/edlin.erl
+++ b/lib/stdlib/src/edlin.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl
index b8e48bff6c..181a524db6 100644
--- a/lib/stdlib/src/epp.erl
+++ b/lib/stdlib/src/epp.erl
@@ -38,7 +38,7 @@
-type epp_handle() :: pid().
-type source_encoding() :: latin1 | utf8.
--type ifdef() :: 'ifdef' | 'ifndef' | 'else'.
+-type ifdef() :: 'ifdef' | 'ifndef' | 'if' | 'else'.
-type name() :: atom().
-type argspec() :: 'none' %No arguments
@@ -117,6 +117,7 @@ open(Name, File, StartLocation, Path, Pdm) ->
{'ok', Epp} | {'ok', Epp, Extra} | {'error', ErrorDescriptor} when
Options :: [{'default_encoding', DefEncoding :: source_encoding()} |
{'includes', IncludePath :: [DirectoryName :: file:name()]} |
+ {'source_name', SourceName :: file:name()} |
{'macros', PredefMacros :: macros()} |
{'name',FileName :: file:name()} |
'extra'],
@@ -221,6 +222,8 @@ format_error({illegal_function,Macro}) ->
io_lib:format("?~s can only be used within a function", [Macro]);
format_error({illegal_function_usage,Macro}) ->
io_lib:format("?~s must not begin a form", [Macro]);
+format_error(elif_after_else) ->
+ "'elif' following 'else'";
format_error({'NYI',What}) ->
io_lib:format("not yet implemented '~s'", [What]);
format_error({error,Term}) ->
@@ -246,6 +249,7 @@ parse_file(Ifile, Path, Predefs) ->
{'ok', [Form]} | {'ok', [Form], Extra} | {error, OpenError} when
FileName :: file:name(),
Options :: [{'includes', IncludePath :: [DirectoryName :: file:name()]} |
+ {'source_name', SourceName :: file:name()} |
{'macros', PredefMacros :: macros()} |
{'default_encoding', DefEncoding :: source_encoding()} |
'extra'],
@@ -479,7 +483,7 @@ com_enc(_B, _Fun, _N, L, Ps) ->
com_enc_end([L | Ps]).
com_enc_end(Ps0) ->
- Ps = lists:reverse([lists:reverse(string:to_lower(P)) || P <- Ps0]),
+ Ps = lists:reverse([lists:reverse(lowercase(P)) || P <- Ps0]),
com_encoding(Ps).
com_encoding(["latin","1"|_]) ->
@@ -489,6 +493,9 @@ com_encoding(["utf","8"|_]) ->
com_encoding(_) ->
throw(no). % Don't try any further
+lowercase(S) ->
+ unicode:characters_to_list(string:lowercase(S)).
+
normalize_typed_record_fields([]) ->
{typed, []};
normalize_typed_record_fields(Fields) ->
@@ -535,9 +542,10 @@ server(Pid, Name, Options, #epp{pre_opened=PreOpened}=St) ->
init_server(Pid, Name, Options, St)
end.
-init_server(Pid, Name, Options, St0) ->
+init_server(Pid, FileName, Options, St0) ->
+ SourceName = proplists:get_value(source_name, Options, FileName),
Pdm = proplists:get_value(macros, Options, []),
- Ms0 = predef_macros(Name),
+ Ms0 = predef_macros(FileName),
case user_predef(Pdm, Ms0) of
{ok,Ms1} ->
#epp{file = File, location = AtLocation} = St0,
@@ -547,14 +555,14 @@ init_server(Pid, Name, Options, St0) ->
epp_reply(Pid, {ok,self(),Encoding}),
%% ensure directory of current source file is
%% first in path
- Path = [filename:dirname(Name) |
+ Path = [filename:dirname(FileName) |
proplists:get_value(includes, Options, [])],
- St = St0#epp{delta=0, name=Name, name2=Name,
+ St = St0#epp{delta=0, name=SourceName, name2=SourceName,
path=Path, macs=Ms1,
default_encoding=DefEncoding},
From = wait_request(St),
Anno = erl_anno:new(AtLocation),
- enter_file_reply(From, file_name(Name), Anno,
+ enter_file_reply(From, file_name(SourceName), Anno,
AtLocation, code),
wait_req_scan(St);
{error,E} ->
@@ -568,6 +576,7 @@ init_server(Pid, Name, Options, St0) ->
predef_macros(File) ->
Machine = list_to_atom(erlang:system_info(machine)),
Anno = line1(),
+ OtpVersion = list_to_integer(erlang:system_info(otp_release)),
Defs = [{'FILE', {none,[{string,Anno,File}]}},
{'FUNCTION_NAME', undefined},
{'FUNCTION_ARITY', undefined},
@@ -577,7 +586,8 @@ predef_macros(File) ->
{'BASE_MODULE', undefined},
{'BASE_MODULE_STRING', undefined},
{'MACHINE', {none,[{atom,Anno,Machine}]}},
- {Machine, {none,[{atom,Anno,true}]}}
+ {Machine, {none,[{atom,Anno,true}]}},
+ {'OTP_RELEASE', {none,[{integer,Anno,OtpVersion}]}}
],
maps:from_list(Defs).
@@ -1082,21 +1092,118 @@ scan_else(_Toks, Else, From, St) ->
epp_reply(From, {error,{loc(Else),epp,{bad,'else'}}}),
wait_req_scan(St).
-%% scan_if(Tokens, EndifToken, From, EppState)
+%% scan_if(Tokens, IfToken, From, EppState)
%% Handle the conditional parsing of a file.
-%% Report a badly formed if test and then treat as false macro.
+scan_if([{'(',_}|_]=Toks, If, From, St) ->
+ try eval_if(Toks, St) of
+ true ->
+ scan_toks(From, St#epp{istk=['if'|St#epp.istk]});
+ _ ->
+ skip_toks(From, St, ['if'])
+ catch
+ throw:Error0 ->
+ Error = case Error0 of
+ {_,erl_parse,_} ->
+ {error,Error0};
+ _ ->
+ {error,{loc(If),epp,Error0}}
+ end,
+ epp_reply(From, Error),
+ wait_req_skip(St, ['if'])
+ end;
scan_if(_Toks, If, From, St) ->
- epp_reply(From, {error,{loc(If),epp,{'NYI','if'}}}),
+ epp_reply(From, {error,{loc(If),epp,{bad,'if'}}}),
wait_req_skip(St, ['if']).
+eval_if(Toks0, St) ->
+ Toks = expand_macros(Toks0, St),
+ Es1 = case erl_parse:parse_exprs(Toks) of
+ {ok,Es0} -> Es0;
+ {error,E} -> throw(E)
+ end,
+ Es = rewrite_expr(Es1, St),
+ assert_guard_expr(Es),
+ Bs = erl_eval:new_bindings(),
+ LocalFun = fun(_Name, _Args) ->
+ error(badarg)
+ end,
+ try erl_eval:exprs(Es, Bs, {value,LocalFun}) of
+ {value,Res,_} ->
+ Res
+ catch
+ _:_ ->
+ false
+ end.
+
+assert_guard_expr([E0]) ->
+ E = rewrite_expr(E0, none),
+ case erl_lint:is_guard_expr(E) of
+ false ->
+ throw({bad,'if'});
+ true ->
+ ok
+ end;
+assert_guard_expr(_) ->
+ throw({bad,'if'}).
+
+%% Dual-purpose rewriting function. When the second argument is
+%% an #epp{} record, calls to defined(Symbol) will be evaluated.
+%% When the second argument is 'none', legal calls to our built-in
+%% functions are eliminated in order to turn the expression into
+%% a legal guard expression.
+
+rewrite_expr({call,_,{atom,_,defined},[N0]}, #epp{macs=Macs}) ->
+ %% Evaluate defined(Symbol).
+ N = case N0 of
+ {var,_,N1} -> N1;
+ {atom,_,N1} -> N1;
+ _ -> throw({bad,'if'})
+ end,
+ {atom,0,maps:is_key(N, Macs)};
+rewrite_expr({call,_,{atom,_,Name},As0}, none) ->
+ As = rewrite_expr(As0, none),
+ Arity = length(As),
+ case erl_internal:bif(Name, Arity) andalso
+ not erl_internal:guard_bif(Name, Arity) of
+ false ->
+ %% A guard BIF, an -if built-in, or an unknown function.
+ %% Eliminate the call so that erl_lint will not complain.
+ %% The call might fail later at evaluation time.
+ to_conses(As);
+ true ->
+ %% An auto-imported BIF (not guard BIF). Not allowed.
+ throw({bad,'if'})
+ end;
+rewrite_expr([H|T], St) ->
+ [rewrite_expr(H, St)|rewrite_expr(T, St)];
+rewrite_expr(Tuple, St) when is_tuple(Tuple) ->
+ list_to_tuple(rewrite_expr(tuple_to_list(Tuple), St));
+rewrite_expr(Other, _) ->
+ Other.
+
+to_conses([H|T]) ->
+ {cons,0,H,to_conses(T)};
+to_conses([]) ->
+ {nil,0}.
+
%% scan_elif(Tokens, EndifToken, From, EppState)
%% Handle the conditional parsing of a file.
%% Report a badly formed if test and then treat as false macro.
scan_elif(_Toks, Elif, From, St) ->
- epp_reply(From, {error,{loc(Elif),epp,{'NYI','elif'}}}),
- wait_req_scan(St).
+ case St#epp.istk of
+ ['else'|Cis] ->
+ epp_reply(From, {error,{loc(Elif),
+ epp,{illegal,"unbalanced",'elif'}}}),
+ wait_req_skip(St#epp{istk=Cis}, ['else']);
+ [_I|Cis] ->
+ skip_toks(From, St#epp{istk=Cis}, ['elif']);
+ [] ->
+ epp_reply(From, {error,{loc(Elif),epp,
+ {illegal,"unbalanced",elif}}}),
+ wait_req_scan(St)
+ end.
%% scan_endif(Tokens, EndifToken, From, EppState)
%% If we are in an if body then exit it, else report an error.
@@ -1155,6 +1262,8 @@ skip_toks(From, St, [I|Sis]) ->
skip_toks(From, St#epp{location=Cl}, ['if',I|Sis]);
{ok,[{'-',_Lh},{atom,_Le,'else'}=Else|_Toks],Cl}->
skip_else(Else, From, St#epp{location=Cl}, [I|Sis]);
+ {ok,[{'-',_Lh},{atom,_Le,'elif'}=Elif|Toks],Cl}->
+ skip_elif(Toks, Elif, From, St#epp{location=Cl}, [I|Sis]);
{ok,[{'-',_Lh},{atom,_Le,endif}|_Toks],Cl} ->
skip_toks(From, St#epp{location=Cl}, Sis);
{ok,_Toks,Cl} ->
@@ -1185,11 +1294,21 @@ skip_toks(From, St, []) ->
skip_else(Else, From, St, ['else'|Sis]) ->
epp_reply(From, {error,{loc(Else),epp,{illegal,"repeated",'else'}}}),
wait_req_skip(St, ['else'|Sis]);
+skip_else(_Else, From, St, ['elif'|Sis]) ->
+ skip_toks(From, St, ['else'|Sis]);
skip_else(_Else, From, St, [_I]) ->
scan_toks(From, St#epp{istk=['else'|St#epp.istk]});
skip_else(_Else, From, St, Sis) ->
skip_toks(From, St, Sis).
+skip_elif(_Toks, Elif, From, St, ['else'|_]=Sis) ->
+ epp_reply(From, {error,{loc(Elif),epp,elif_after_else}}),
+ wait_req_skip(St, Sis);
+skip_elif(Toks, Elif, From, St, [_I]) ->
+ scan_if(Toks, Elif, From, St);
+skip_elif(_Toks, _Elif, From, St, Sis) ->
+ skip_toks(From, St, Sis).
+
%% macro_pars(Tokens, ArgStack)
%% macro_expansion(Tokens, Anno)
%% Extract the macro parameters and the expansion from a macro definition.
diff --git a/lib/stdlib/src/erl_compile.erl b/lib/stdlib/src/erl_compile.erl
index 18d7548fdc..f781312ca2 100644
--- a/lib/stdlib/src/erl_compile.erl
+++ b/lib/stdlib/src/erl_compile.erl
@@ -188,6 +188,8 @@ parse_dep_option("", T) ->
{[makedep,{makedep_output,standard_io}],T};
parse_dep_option("D", T) ->
{[makedep],T};
+parse_dep_option("MD", T) ->
+ {[makedep_side_effect],T};
parse_dep_option("F"++Opt, T0) ->
{File,T} = get_option("MF", Opt, T0),
{[makedep,{makedep_output,File}],T};
@@ -221,6 +223,7 @@ usage() ->
"the dependencies"},
{"-MP","add a phony target for each dependency"},
{"-MD","same as -M -MT file (with default 'file')"},
+ {"-MMD","generate dependencies as a side-effect"},
{"-o name","name output directory or file"},
{"-pa path","add path to the front of Erlang's code path"},
{"-pz path","add path to the end of Erlang's code path"},
diff --git a/lib/stdlib/src/lib.erl b/lib/stdlib/src/erl_error.erl
index be11e86100..fdcb9e824c 100644
--- a/lib/stdlib/src/lib.erl
+++ b/lib/stdlib/src/erl_error.erl
@@ -17,337 +17,12 @@
%%
%% %CopyrightEnd%
%%
--module(lib).
-
--export([flush_receive/0, error_message/2, progname/0, nonl/1, send/2,
- sendw/2, eval_str/1]).
-
--export([extended_parse_exprs/1, extended_parse_term/1,
- subst_values_for_vars/2]).
+-module(erl_error).
-export([format_exception/6, format_exception/7,
format_stacktrace/4, format_stacktrace/5,
format_call/4, format_call/5, format_fun/1, format_fun/2]).
--spec flush_receive() -> 'ok'.
-
-flush_receive() ->
- receive
- _Any ->
- flush_receive()
- after
- 0 ->
- ok
- end.
-
-%%
-%% Functions for doing standard system format i/o.
-%%
--spec error_message(Format, Args) -> 'ok' when
- Format :: io:format(),
- Args :: [term()].
-
-error_message(Format, Args) ->
- io:format(<<"** ~ts **\n">>, [io_lib:format(Format, Args)]).
-
-%% Return the name of the script that starts (this) erlang
-%%
--spec progname() -> atom().
-
-progname() ->
- case init:get_argument(progname) of
- {ok, [[Prog]]} ->
- list_to_atom(Prog);
- _Other ->
- no_prog_name
- end.
-
--spec nonl(String1) -> String2 when
- String1 :: string(),
- String2 :: string().
-
-nonl([10]) -> [];
-nonl([]) -> [];
-nonl([H|T]) -> [H|nonl(T)].
-
--spec send(To, Msg) -> Msg when
- To :: pid() | atom() | {atom(), node()},
- Msg :: term().
-
-send(To, Msg) -> To ! Msg.
-
--spec sendw(To, Msg) -> term() when
- To :: pid() | atom() | {atom(), node()},
- Msg :: term().
-
-sendw(To, Msg) ->
- To ! {self(), Msg},
- receive
- Reply -> Reply
- end.
-
-%% eval_str(InStr) -> {ok, OutStr} | {error, ErrStr'}
-%% InStr must represent a body
-%% Note: If InStr is a binary it has to be a Latin-1 string.
-%% If you have a UTF-8 encoded binary you have to call
-%% unicode:characters_to_list/1 before the call to eval_str().
-
--define(result(F,D), lists:flatten(io_lib:format(F, D))).
-
--spec eval_str(string() | unicode:latin1_binary()) ->
- {'ok', string()} | {'error', string()}.
-
-eval_str(Str) when is_list(Str) ->
- case erl_scan:tokens([], Str, 0) of
- {more, _} ->
- {error, "Incomplete form (missing .<cr>)??"};
- {done, {ok, Toks, _}, Rest} ->
- case all_white(Rest) of
- true ->
- case erl_parse:parse_exprs(Toks) of
- {ok, Exprs} ->
- case catch erl_eval:exprs(Exprs, erl_eval:new_bindings()) of
- {value, Val, _} ->
- {ok, Val};
- Other ->
- {error, ?result("*** eval: ~p", [Other])}
- end;
- {error, {_Line, Mod, Args}} ->
- Msg = ?result("*** ~ts",[Mod:format_error(Args)]),
- {error, Msg}
- end;
- false ->
- {error, ?result("Non-white space found after "
- "end-of-form :~ts", [Rest])}
- end
- end;
-eval_str(Bin) when is_binary(Bin) ->
- eval_str(binary_to_list(Bin)).
-
-all_white([$\s|T]) -> all_white(T);
-all_white([$\n|T]) -> all_white(T);
-all_white([$\t|T]) -> all_white(T);
-all_white([]) -> true;
-all_white(_) -> false.
-
-%% `Tokens' is assumed to have been scanned with the 'text' option.
-%% The annotations of the returned expressions are locations.
-%%
-%% Can handle pids, ports, references, and external funs ("items").
-%% Known items are represented by variables in the erl_parse tree, and
-%% the items themselves are stored in the returned bindings.
-
--spec extended_parse_exprs(Tokens) ->
- {'ok', ExprList, Bindings} | {'error', ErrorInfo} when
- Tokens :: [erl_scan:token()],
- ExprList :: [erl_parse:abstract_expr()],
- Bindings :: erl_eval:binding_struct(),
- ErrorInfo :: erl_parse:error_info().
-
-extended_parse_exprs(Tokens) ->
- Ts = tokens_fixup(Tokens),
- case erl_parse:parse_exprs(Ts) of
- {ok, Exprs0} ->
- {Exprs, Bs} = expr_fixup(Exprs0),
- {ok, reset_expr_anno(Exprs), Bs};
- _ErrorInfo ->
- erl_parse:parse_exprs(reset_token_anno(Ts))
- end.
-
-tokens_fixup([]) -> [];
-tokens_fixup([T|Ts]=Ts0) ->
- try token_fixup(Ts0) of
- {NewT, NewTs} ->
- [NewT|tokens_fixup(NewTs)]
- catch
- _:_ ->
- [T|tokens_fixup(Ts)]
- end.
-
-token_fixup(Ts) ->
- {AnnoL, NewTs, FixupTag} = unscannable(Ts),
- String = lists:append([erl_anno:text(A) || A <- AnnoL]),
- _ = (fixup_fun(FixupTag))(String),
- NewAnno = erl_anno:set_text(fixup_text(FixupTag), hd(AnnoL)),
- {{string, NewAnno, String}, NewTs}.
-
-unscannable([{'#', A1}, {var, A2, 'Fun'}, {'<', A3}, {atom, A4, _},
- {'.', A5}, {float, A6, _}, {'>', A7}|Ts]) ->
- {[A1, A2, A3, A4, A5, A6, A7], Ts, function};
-unscannable([{'#', A1}, {var, A2, 'Fun'}, {'<', A3}, {atom, A4, _},
- {'.', A5}, {atom, A6, _}, {'.', A7}, {integer, A8, _},
- {'>', A9}|Ts]) ->
- {[A1, A2, A3, A4, A5, A6, A7, A8, A9], Ts, function};
-unscannable([{'<', A1}, {float, A2, _}, {'.', A3}, {integer, A4, _},
- {'>', A5}|Ts]) ->
- {[A1, A2, A3, A4, A5], Ts, pid};
-unscannable([{'#', A1}, {var, A2, 'Port'}, {'<', A3}, {float, A4, _},
- {'>', A5}|Ts]) ->
- {[A1, A2, A3, A4, A5], Ts, port};
-unscannable([{'#', A1}, {var, A2, 'Ref'}, {'<', A3}, {float, A4, _},
- {'.', A5}, {float, A6, _}, {'>', A7}|Ts]) ->
- {[A1, A2, A3, A4, A5, A6, A7], Ts, reference}.
-
-expr_fixup(Expr0) ->
- {Expr, Bs, _} = expr_fixup(Expr0, erl_eval:new_bindings(), 1),
- {Expr, Bs}.
-
-expr_fixup({string,A,S}=T, Bs0, I) ->
- try string_fixup(A, S) of
- Value ->
- Var = new_var(I),
- Bs = erl_eval:add_binding(Var, Value, Bs0),
- {{var, A, Var}, Bs, I+1}
- catch
- _:_ ->
- {T, Bs0, I}
- end;
-expr_fixup(Tuple, Bs0, I0) when is_tuple(Tuple) ->
- {L, Bs, I} = expr_fixup(tuple_to_list(Tuple), Bs0, I0),
- {list_to_tuple(L), Bs, I};
-expr_fixup([E0|Es0], Bs0, I0) ->
- {E, Bs1, I1} = expr_fixup(E0, Bs0, I0),
- {Es, Bs, I} = expr_fixup(Es0, Bs1, I1),
- {[E|Es], Bs, I};
-expr_fixup(T, Bs, I) ->
- {T, Bs, I}.
-
-string_fixup(A, S) ->
- Text = erl_anno:text(A),
- FixupTag = fixup_tag(Text, S),
- (fixup_fun(FixupTag))(S).
-
-new_var(I) ->
- list_to_atom(lists:concat(['__ExtendedParseExprs_', I, '__'])).
-
-reset_token_anno(Tokens) ->
- [setelement(2, T, (reset_anno())(element(2, T))) || T <- Tokens].
-
-reset_expr_anno(Exprs) ->
- [erl_parse:map_anno(reset_anno(), E) || E <- Exprs].
-
-reset_anno() ->
- fun(A) -> erl_anno:new(erl_anno:location(A)) end.
-
-fixup_fun(function) -> fun function/1;
-fixup_fun(pid) -> fun erlang:list_to_pid/1;
-fixup_fun(port) -> fun erlang:list_to_port/1;
-fixup_fun(reference) -> fun erlang:list_to_ref/1.
-
-function(S) ->
- %% External function.
- {ok, [_, _, _,
- {atom, _, Module}, _,
- {atom, _, Function}, _,
- {integer, _, Arity}|_], _} = erl_scan:string(S),
- erlang:make_fun(Module, Function, Arity).
-
-fixup_text(function) -> "function";
-fixup_text(pid) -> "pid";
-fixup_text(port) -> "port";
-fixup_text(reference) -> "reference".
-
-fixup_tag("function", "#"++_) -> function;
-fixup_tag("pid", "<"++_) -> pid;
-fixup_tag("port", "#"++_) -> port;
-fixup_tag("reference", "#"++_) -> reference.
-
-%%% End of extended_parse_exprs.
-
-%% `Tokens' is assumed to have been scanned with the 'text' option.
-%%
-%% Can handle pids, ports, references, and external funs.
-
--spec extended_parse_term(Tokens) ->
- {'ok', Term} | {'error', ErrorInfo} when
- Tokens :: [erl_scan:token()],
- Term :: term(),
- ErrorInfo :: erl_parse:error_info().
-
-extended_parse_term(Tokens) ->
- case extended_parse_exprs(Tokens) of
- {ok, [Expr], Bindings} ->
- try normalise(Expr, Bindings) of
- Term ->
- {ok, Term}
- catch
- _:_ ->
- Loc = erl_anno:location(element(2, Expr)),
- {error,{Loc,?MODULE,"bad term"}}
- end;
- {ok, [_,Expr|_], _Bindings} ->
- Loc = erl_anno:location(element(2, Expr)),
- {error,{Loc,?MODULE,"bad term"}};
- {error, _} = Error ->
- Error
- end.
-
-%% From erl_parse.
-normalise({var, _, V}, Bs) ->
- {value, Value} = erl_eval:binding(V, Bs),
- Value;
-normalise({char,_,C}, _Bs) -> C;
-normalise({integer,_,I}, _Bs) -> I;
-normalise({float,_,F}, _Bs) -> F;
-normalise({atom,_,A}, _Bs) -> A;
-normalise({string,_,S}, _Bs) -> S;
-normalise({nil,_}, _Bs) -> [];
-normalise({bin,_,Fs}, Bs) ->
- {value, B, _} =
- eval_bits:expr_grp(Fs, [],
- fun(E, _) ->
- {value, normalise(E, Bs), []}
- end, [], true),
- B;
-normalise({cons,_,Head,Tail}, Bs) ->
- [normalise(Head, Bs)|normalise(Tail, Bs)];
-normalise({tuple,_,Args}, Bs) ->
- list_to_tuple(normalise_list(Args, Bs));
-normalise({map,_,Pairs}, Bs) ->
- maps:from_list(lists:map(fun
- %% only allow '=>'
- ({map_field_assoc,_,K,V}) ->
- {normalise(K, Bs),normalise(V, Bs)}
- end, Pairs));
-%% Special case for unary +/-.
-normalise({op,_,'+',{char,_,I}}, _Bs) -> I;
-normalise({op,_,'+',{integer,_,I}}, _Bs) -> I;
-normalise({op,_,'+',{float,_,F}}, _Bs) -> F;
-normalise({op,_,'-',{char,_,I}}, _Bs) -> -I; %Weird, but compatible!
-normalise({op,_,'-',{integer,_,I}}, _Bs) -> -I;
-normalise({op,_,'-',{float,_,F}}, _Bs) -> -F;
-normalise({'fun',_,{function,{atom,_,M},{atom,_,F},{integer,_,A}}}, _Bs) ->
- %% Since "#Fun<M.F.A>" is recognized, "fun M:F/A" should be too.
- fun M:F/A.
-
-normalise_list([H|T], Bs) ->
- [normalise(H, Bs)|normalise_list(T, Bs)];
-normalise_list([], _Bs) ->
- [].
-
-%% To be used on ExprList and Bindings returned from extended_parse_exprs().
-%% Substitute {value, A, Item} for {var, A, ExtendedParseVar}.
-%% {value, A, Item} is a shell/erl_eval convention, and for example
-%% the linter cannot handle it.
-
--spec subst_values_for_vars(ExprList, Bindings) -> [term()] when
- ExprList :: [erl_parse:abstract_expr()],
- Bindings :: erl_eval:binding_struct().
-
-subst_values_for_vars({var, A, V}=Var, Bs) ->
- case erl_eval:binding(V, Bs) of
- {value, Value} ->
- {value, A, Value};
- unbound ->
- Var
- end;
-subst_values_for_vars(L, Bs) when is_list(L) ->
- [subst_values_for_vars(E, Bs) || E <- L];
-subst_values_for_vars(T, Bs) when is_tuple(T) ->
- list_to_tuple(subst_values_for_vars(tuple_to_list(T), Bs));
-subst_values_for_vars(T, _Bs) ->
- T.
-
%%% Formatting of exceptions, mfa:s and funs.
%% -> iolist() (no \n at end)
@@ -646,7 +321,7 @@ pp_arguments(PF, As, I, Enc) ->
Ll = length(L),
A = list_to_atom(lists:duplicate(Ll, $a)),
S0 = unicode:characters_to_list(PF([A | T], I+1), Enc),
- brackets_to_parens([$[,L,string:sub_string(S0, 2+Ll)], Enc);
+ brackets_to_parens([$[,L,string:slice(S0, 1+Ll)], Enc);
_ ->
brackets_to_parens(PF(As, I+1), Enc)
end.
diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl
index eafee346eb..2066b2f60f 100644
--- a/lib/stdlib/src/erl_eval.erl
+++ b/lib/stdlib/src/erl_eval.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -27,8 +27,9 @@
-export([exprs/2,exprs/3,exprs/4,expr/2,expr/3,expr/4,expr/5,
expr_list/2,expr_list/3,expr_list/4]).
-export([new_bindings/0,bindings/1,binding/2,add_binding/3,del_binding/2]).
-
--export([is_constant_expr/1, partial_eval/1]).
+-export([extended_parse_exprs/1, extended_parse_term/1,
+ subst_values_for_vars/2]).
+-export([is_constant_expr/1, partial_eval/1, eval_str/1]).
%% Is used by standalone Erlang (escript).
%% Also used by shell.erl.
@@ -69,6 +70,9 @@
-type(non_local_function_handler() :: {value, nlfun_handler()}
| none).
+-define(STACKTRACE,
+ element(2, erlang:process_info(self(), current_stacktrace))).
+
%% exprs(ExpressionSeq, Bindings)
%% exprs(ExpressionSeq, Bindings, LocalFuncHandler)
%% exprs(ExpressionSeq, Bindings, LocalFuncHandler, ExternalFuncHandler)
@@ -90,7 +94,7 @@ exprs(Exprs, Bs) ->
ok ->
exprs(Exprs, Bs, none, none, none);
{error,{_Line,_Mod,Error}} ->
- erlang:raise(error, Error, [{?MODULE,exprs,2}])
+ erlang:raise(error, Error, ?STACKTRACE)
end.
-spec(exprs(Expressions, Bindings, LocalFunctionHandler) ->
@@ -141,7 +145,7 @@ expr(E, Bs) ->
ok ->
expr(E, Bs, none, none, none);
{error,{_Line,_Mod,Error}} ->
- erlang:raise(error, Error, [{?MODULE,expr,2}])
+ erlang:raise(error, Error, ?STACKTRACE)
end.
-spec(expr(Expression, Bindings, LocalFunctionHandler) ->
@@ -182,7 +186,7 @@ check_command(Es, Bs) ->
fun_data(F) when is_function(F) ->
case erlang:fun_info(F, module) of
- {module,erl_eval} ->
+ {module,?MODULE} ->
case erlang:fun_info(F, env) of
{env,[{FBs,_FLf,_FEf,FCs}]} ->
{fun_data,FBs,FCs};
@@ -209,8 +213,8 @@ expr({var,_,V}, Bs, _Lf, _Ef, RBs) ->
case binding(V, Bs) of
{value,Val} ->
ret_expr(Val, Bs, RBs);
- unbound -> % Should not happen.
- erlang:raise(error, {unbound,V}, stacktrace())
+ unbound -> % Cannot not happen if checked by erl_lint
+ erlang:raise(error, {unbound,V}, ?STACKTRACE)
end;
expr({char,_,C}, Bs, _Lf, _Ef, RBs) ->
ret_expr(C, Bs, RBs);
@@ -236,13 +240,13 @@ expr({tuple,_,Es}, Bs0, Lf, Ef, RBs) ->
{Vs,Bs} = expr_list(Es, Bs0, Lf, Ef),
ret_expr(list_to_tuple(Vs), Bs, RBs);
expr({record_field,_,_,Name,_}, _Bs, _Lf, _Ef, _RBs) ->
- erlang:raise(error, {undef_record,Name}, stacktrace());
+ erlang:raise(error, {undef_record,Name}, ?STACKTRACE);
expr({record_index,_,Name,_}, _Bs, _Lf, _Ef, _RBs) ->
- erlang:raise(error, {undef_record,Name}, stacktrace());
+ erlang:raise(error, {undef_record,Name}, ?STACKTRACE);
expr({record,_,Name,_}, _Bs, _Lf, _Ef, _RBs) ->
- erlang:raise(error, {undef_record,Name}, stacktrace());
+ erlang:raise(error, {undef_record,Name}, ?STACKTRACE);
expr({record,_,_,Name,_}, _Bs, _Lf, _Ef, _RBs) ->
- erlang:raise(error, {undef_record,Name}, stacktrace());
+ erlang:raise(error, {undef_record,Name}, ?STACKTRACE);
%% map
expr({map,_,Binding,Es}, Bs0, Lf, Ef, RBs) ->
@@ -281,7 +285,7 @@ expr({'fun',_Line,{function,Mod0,Name0,Arity0}}, Bs0, Lf, Ef, RBs) ->
ret_expr(F, Bs, RBs);
expr({'fun',_Line,{function,Name,Arity}}, _Bs0, _Lf, _Ef, _RBs) -> % R8
%% Don't know what to do...
- erlang:raise(error, undef, [{erl_eval,Name,Arity}|stacktrace()]);
+ erlang:raise(error, undef, [{?MODULE,Name,Arity}|?STACKTRACE]);
expr({'fun',Line,{clauses,Cs}} = Ex, Bs, Lf, Ef, RBs) ->
%% Save only used variables in the function environment.
%% {value,L,V} are hidden while lint finds used variables.
@@ -325,8 +329,9 @@ expr({'fun',Line,{clauses,Cs}} = Ex, Bs, Lf, Ef, RBs) ->
20 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T) ->
eval_fun([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T], Info) end;
_Other ->
- erlang:raise(error, {'argument_limit',{'fun',Line,Cs}},
- stacktrace())
+ L = erl_anno:location(Line),
+ erlang:raise(error, {'argument_limit',{'fun',L,to_terms(Cs)}},
+ ?STACKTRACE)
end,
ret_expr(F, Bs, RBs);
expr({named_fun,Line,Name,Cs} = Ex, Bs, Lf, Ef, RBs) ->
@@ -377,8 +382,10 @@ expr({named_fun,Line,Name,Cs} = Ex, Bs, Lf, Ef, RBs) ->
eval_named_fun([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T],
RF, Info) end;
_Other ->
- erlang:raise(error, {'argument_limit',{named_fun,Line,Name,Cs}},
- stacktrace())
+ L = erl_anno:location(Line),
+ erlang:raise(error, {'argument_limit',
+ {named_fun,L,Name,to_terms(Cs)}},
+ ?STACKTRACE)
end,
ret_expr(F, Bs, RBs);
expr({call,_,{remote,_,{atom,_,qlc},{atom,_,q}},[{lc,_,_E,_Qs}=LC | As0]},
@@ -422,25 +429,28 @@ expr({call,_,Func0,As0}, Bs0, Lf, Ef, RBs) -> % function or {Mod,Fun}
{As,Bs2} = expr_list(As0, Bs1, Lf, Ef),
case Func of
{M,F} when is_atom(M), is_atom(F) ->
- erlang:raise(error, {badfun,Func}, stacktrace());
+ erlang:raise(error, {badfun,Func}, ?STACKTRACE);
_ ->
do_apply(Func, As, Bs2, Ef, RBs)
end;
expr({'catch',_,Expr}, Bs0, Lf, Ef, RBs) ->
- Ref = make_ref(),
- case catch {Ref,expr(Expr, Bs0, Lf, Ef, none)} of
- {Ref,{value,V,Bs}} -> % Nothing was thrown (guaranteed).
- ret_expr(V, Bs, RBs);
- Other ->
- ret_expr(Other, Bs0, RBs)
+ try expr(Expr, Bs0, Lf, Ef, none) of
+ {value,V,Bs} ->
+ ret_expr(V, Bs, RBs)
+ catch
+ throw:Term ->
+ ret_expr(Term, Bs0, RBs);
+ exit:Reason ->
+ ret_expr({'EXIT',Reason}, Bs0, RBs);
+ error:Reason:Stacktrace ->
+ ret_expr({'EXIT',{Reason,Stacktrace}}, Bs0, RBs)
end;
expr({match,_,Lhs,Rhs0}, Bs0, Lf, Ef, RBs) ->
{value,Rhs,Bs1} = expr(Rhs0, Bs0, Lf, Ef, none),
case match(Lhs, Rhs, Bs1) of
{match,Bs} ->
ret_expr(Rhs, Bs, RBs);
- nomatch ->
- erlang:raise(error, {badmatch,Rhs}, stacktrace())
+ nomatch -> erlang:raise(error, {badmatch,Rhs}, ?STACKTRACE)
end;
expr({op,_,Op,A0}, Bs0, Lf, Ef, RBs) ->
{value,A,Bs} = expr(A0, Bs0, Lf, Ef, none),
@@ -452,7 +462,7 @@ expr({op,_,'andalso',L0,R0}, Bs0, Lf, Ef, RBs) ->
{value,R,_} = expr(R0, Bs1, Lf, Ef, none),
R;
false -> false;
- _ -> erlang:raise(error, {badarg,L}, stacktrace())
+ _ -> erlang:raise(error, {badarg,L}, ?STACKTRACE)
end,
ret_expr(V, Bs1, RBs);
expr({op,_,'orelse',L0,R0}, Bs0, Lf, Ef, RBs) ->
@@ -462,7 +472,7 @@ expr({op,_,'orelse',L0,R0}, Bs0, Lf, Ef, RBs) ->
false ->
{value,R,_} = expr(R0, Bs1, Lf, Ef, none),
R;
- _ -> erlang:raise(error, {badarg,L}, stacktrace())
+ _ -> erlang:raise(error, {badarg,L}, ?STACKTRACE)
end,
ret_expr(V, Bs1, RBs);
expr({op,_,Op,L0,R0}, Bs0, Lf, Ef, RBs) ->
@@ -474,7 +484,7 @@ expr({bin,_,Fs}, Bs0, Lf, Ef, RBs) ->
{value,V,Bs} = eval_bits:expr_grp(Fs, Bs0, EvalFun),
ret_expr(V, Bs, RBs);
expr({remote,_,_,_}, _Bs, _Lf, _Ef, _RBs) ->
- erlang:raise(error, {badexpr,':'}, stacktrace());
+ erlang:raise(error, {badexpr,':'}, ?STACKTRACE);
expr({value,_,Val}, Bs, _Lf, _Ef, RBs) -> % Special case straight values.
ret_expr(Val, Bs, RBs).
@@ -570,7 +580,7 @@ local_func(Func, As, _Bs, {M,F,Eas}, _Ef, RBs) ->
local_func2(apply(M, F, [Func,As|Eas]), RBs);
%% Default unknown function handler to undefined function.
local_func(Func, As0, _Bs0, none, _Ef, _RBs) ->
- erlang:raise(error, undef, [{erl_eval,Func,length(As0)}|stacktrace()]).
+ erlang:raise(error, undef, [{?MODULE,Func,length(As0)}|?STACKTRACE]).
local_func2({value,V,Bs}, RBs) ->
ret_expr(V, Bs, RBs);
@@ -637,7 +647,7 @@ do_apply(Func, As, Bs0, Ef, RBs) ->
{{arity, Arity}, Arity} ->
eval_fun(FCs, As, FBs, FLf, FEf, NRBs);
_ ->
- erlang:raise(error, {badarity,{Func,As}},stacktrace())
+ erlang:raise(error, {badarity,{Func,As}},?STACKTRACE)
end;
{{env,[{FBs,FLf,FEf,FCs,FName}]},_} ->
NRBs = if
@@ -648,7 +658,7 @@ do_apply(Func, As, Bs0, Ef, RBs) ->
{{arity, Arity}, Arity} ->
eval_named_fun(FCs, As, FBs, FLf, FEf, FName, Func, NRBs);
_ ->
- erlang:raise(error, {badarity,{Func,As}},stacktrace())
+ erlang:raise(error, {badarity,{Func,As}},?STACKTRACE)
end;
{no_env,none} when RBs =:= value ->
%% Make tail recursive calls when possible.
@@ -730,7 +740,7 @@ eval_generate([V|Rest], P, Bs0, Lf, Ef, CompFun, Acc) ->
eval_generate([], _P, _Bs0, _Lf, _Ef, _CompFun, Acc) ->
Acc;
eval_generate(Term, _P, _Bs0, _Lf, _Ef, _CompFun, _Acc) ->
- erlang:raise(error, {bad_generator,Term}, stacktrace()).
+ erlang:raise(error, {bad_generator,Term}, ?STACKTRACE).
eval_b_generate(<<_/bitstring>>=Bin, P, Bs0, Lf, Ef, CompFun, Acc) ->
Mfun = match_fun(Bs0),
@@ -746,7 +756,7 @@ eval_b_generate(<<_/bitstring>>=Bin, P, Bs0, Lf, Ef, CompFun, Acc) ->
Acc
end;
eval_b_generate(Term, _P, _Bs0, _Lf, _Ef, _CompFun, _Acc) ->
- erlang:raise(error, {bad_generator,Term}, stacktrace()).
+ erlang:raise(error, {bad_generator,Term}, ?STACKTRACE).
eval_filter(F, Bs0, Lf, Ef, CompFun, Acc) ->
case erl_lint:is_guard_test(F) of
@@ -760,7 +770,7 @@ eval_filter(F, Bs0, Lf, Ef, CompFun, Acc) ->
{value,true,Bs1} -> CompFun(Bs1);
{value,false,_} -> Acc;
{value,V,_} ->
- erlang:raise(error, {bad_filter,V}, stacktrace())
+ erlang:raise(error, {bad_filter,V}, ?STACKTRACE)
end
end.
@@ -816,7 +826,7 @@ eval_fun([{clause,_,H,G,B}|Cs], As, Bs0, Lf, Ef, RBs) ->
end;
eval_fun([], As, _Bs, _Lf, _Ef, _RBs) ->
erlang:raise(error, function_clause,
- [{?MODULE,'-inside-an-interpreted-fun-',As}|stacktrace()]).
+ [{?MODULE,'-inside-an-interpreted-fun-',As}|?STACKTRACE]).
eval_named_fun(As, Fun, {Bs0,Lf,Ef,Cs,Name}) ->
@@ -836,7 +846,7 @@ eval_named_fun([{clause,_,H,G,B}|Cs], As, Bs0, Lf, Ef, Name, Fun, RBs) ->
end;
eval_named_fun([], As, _Bs, _Lf, _Ef, _Name, _Fun, _RBs) ->
erlang:raise(error, function_clause,
- [{?MODULE,'-inside-an-interpreted-fun-',As}|stacktrace()]).
+ [{?MODULE,'-inside-an-interpreted-fun-',As}|?STACKTRACE]).
%% expr_list(ExpressionList, Bindings)
@@ -894,13 +904,13 @@ if_clauses([{clause,_,[],G,B}|Cs], Bs, Lf, Ef, RBs) ->
false -> if_clauses(Cs, Bs, Lf, Ef, RBs)
end;
if_clauses([], _Bs, _Lf, _Ef, _RBs) ->
- erlang:raise(error, if_clause, stacktrace()).
+ erlang:raise(error, if_clause, ?STACKTRACE).
%% try_clauses(Body, CaseClauses, CatchClauses, AfterBody, Bindings,
%% LocalFuncHandler, ExtFuncHandler, RBs)
-%% When/if variable bindings between the different parts of a
-%% try-catch expression are introduced this will have to be rewritten.
+
try_clauses(B, Cases, Catches, AB, Bs, Lf, Ef, RBs) ->
+ check_stacktrace_vars(Catches, Bs),
try exprs(B, Bs, Lf, Ef, none) of
{value,V,Bs1} when Cases =:= [] ->
ret_expr(V, Bs1, RBs);
@@ -909,23 +919,18 @@ try_clauses(B, Cases, Catches, AB, Bs, Lf, Ef, RBs) ->
{B2,Bs2} ->
exprs(B2, Bs2, Lf, Ef, RBs);
nomatch ->
- erlang:raise(error, {try_clause,V}, stacktrace())
+ erlang:raise(error, {try_clause,V}, ?STACKTRACE)
end
catch
- Class:Reason when Catches =:= [] ->
- %% Rethrow
- erlang:raise(Class, Reason, stacktrace());
- Class:Reason ->
-%%% %% Set stacktrace
-%%% try erlang:raise(Class, Reason, stacktrace())
-%%% catch _:_ -> ok
-%%% end,
- V = {Class,Reason,erlang:get_stacktrace()},
- case match_clause(Catches, [V],Bs, Lf, Ef) of
+ Class:Reason:Stacktrace when Catches =:= [] ->
+ erlang:raise(Class, Reason, Stacktrace);
+ Class:Reason:Stacktrace ->
+ V = {Class,Reason,Stacktrace},
+ case match_clause(Catches, [V], Bs, Lf, Ef) of
{B2,Bs2} ->
exprs(B2, Bs2, Lf, Ef, RBs);
nomatch ->
- erlang:raise(Class, Reason, stacktrace())
+ erlang:raise(Class, Reason, Stacktrace)
end
after
if AB =:= [] ->
@@ -935,6 +940,23 @@ try_clauses(B, Cases, Catches, AB, Bs, Lf, Ef, RBs) ->
end
end.
+check_stacktrace_vars([{clause,_,[{tuple,_,[_,_,STV]}],_,_}|Cs], Bs) ->
+ case STV of
+ {var,_,V} ->
+ case binding(V, Bs) of
+ {value, _} ->
+ erlang:raise(error, stacktrace_bound, ?STACKTRACE);
+ unbound ->
+ check_stacktrace_vars(Cs, Bs)
+ end;
+ _ ->
+ erlang:raise(error,
+ {illegal_stacktrace_variable,STV},
+ ?STACKTRACE)
+ end;
+check_stacktrace_vars([], _Bs) ->
+ ok.
+
%% case_clauses(Value, Clauses, Bindings, LocalFuncHandler, ExtFuncHandler,
%% RBs)
@@ -943,7 +965,7 @@ case_clauses(Val, Cs, Bs, Lf, Ef, RBs) ->
{B, Bs1} ->
exprs(B, Bs1, Lf, Ef, RBs);
nomatch ->
- erlang:raise(error, {case_clause,Val}, stacktrace())
+ erlang:raise(error, {case_clause,Val}, ?STACKTRACE)
end.
%%
@@ -1018,7 +1040,7 @@ guard0([G|Gs], Bs0, Lf, Ef) ->
{value,false,_} -> false
end;
false ->
- erlang:raise(error, guard_expr, stacktrace())
+ erlang:raise(error, guard_expr, ?STACKTRACE)
end;
guard0([], _Bs, _Lf, _Ef) -> true.
@@ -1073,7 +1095,7 @@ match(Pat, Term, Bs) ->
match(Pat, Term, Bs, BBs) ->
case catch match1(Pat, Term, Bs, BBs) of
invalid ->
- erlang:raise(error, {illegal_pattern,Pat}, stacktrace());
+ erlang:raise(error, {illegal_pattern,to_term(Pat)}, ?STACKTRACE);
Other ->
Other
end.
@@ -1254,7 +1276,7 @@ merge_bindings(Bs1, Bs2) ->
case orddict:find(Name, Bs) of
{ok,Val} -> Bs; %Already with SAME value
{ok,V1} ->
- erlang:raise(error, {badmatch,V1}, stacktrace());
+ erlang:raise(error, {badmatch,V1}, ?STACKTRACE);
error -> orddict:store(Name, Val, Bs)
end end,
Bs2, orddict:to_list(Bs1)).
@@ -1264,10 +1286,234 @@ merge_bindings(Bs1, Bs2) ->
%% fun (Name, Val, Bs) ->
%% case orddict:find(Name, Bs) of
%% {ok,Val} -> orddict:erase(Name, Bs);
-%% {ok,V1} -> erlang:raise(error,{badmatch,V1},stacktrace());
+%% {ok,V1} -> erlang:raise(error,{badmatch,V1},?STACKTRACE);
%% error -> Bs
%% end
%% end, Bs2, Bs1).
+
+to_terms(Abstrs) ->
+ [to_term(Abstr) || Abstr <- Abstrs].
+
+to_term(Abstr) ->
+ erl_parse:anno_to_term(Abstr).
+
+%% Substitute {value, A, Item} for {var, A, Var}, preserving A.
+%% {value, A, Item} is a shell/erl_eval convention, and for example
+%% the linter cannot handle it.
+
+-spec subst_values_for_vars(ExprList, Bindings) -> [term()] when
+ ExprList :: [erl_parse:abstract_expr()],
+ Bindings :: binding_struct().
+
+subst_values_for_vars({var, A, V}=Var, Bs) ->
+ case erl_eval:binding(V, Bs) of
+ {value, Value} ->
+ {value, A, Value};
+ unbound ->
+ Var
+ end;
+subst_values_for_vars(L, Bs) when is_list(L) ->
+ [subst_values_for_vars(E, Bs) || E <- L];
+subst_values_for_vars(T, Bs) when is_tuple(T) ->
+ list_to_tuple(subst_values_for_vars(tuple_to_list(T), Bs));
+subst_values_for_vars(T, _Bs) ->
+ T.
+
+%% `Tokens' is assumed to have been scanned with the 'text' option.
+%% The annotations of the returned expressions are locations.
+%%
+%% Can handle pids, ports, references, and external funs ("items").
+%% Known items are represented by variables in the erl_parse tree, and
+%% the items themselves are stored in the returned bindings.
+
+-spec extended_parse_exprs(Tokens) ->
+ {'ok', ExprList, Bindings} | {'error', ErrorInfo} when
+ Tokens :: [erl_scan:token()],
+ ExprList :: [erl_parse:abstract_expr()],
+ Bindings :: erl_eval:binding_struct(),
+ ErrorInfo :: erl_parse:error_info().
+
+extended_parse_exprs(Tokens) ->
+ Ts = tokens_fixup(Tokens),
+ case erl_parse:parse_exprs(Ts) of
+ {ok, Exprs0} ->
+ {Exprs, Bs} = expr_fixup(Exprs0),
+ {ok, reset_expr_anno(Exprs), Bs};
+ _ErrorInfo ->
+ erl_parse:parse_exprs(reset_token_anno(Ts))
+ end.
+
+tokens_fixup([]) -> [];
+tokens_fixup([T|Ts]=Ts0) ->
+ try token_fixup(Ts0) of
+ {NewT, NewTs} ->
+ [NewT|tokens_fixup(NewTs)]
+ catch
+ _:_ ->
+ [T|tokens_fixup(Ts)]
+ end.
+
+token_fixup(Ts) ->
+ {AnnoL, NewTs, FixupTag} = unscannable(Ts),
+ String = lists:append([erl_anno:text(A) || A <- AnnoL]),
+ _ = (fixup_fun(FixupTag))(String),
+ NewAnno = erl_anno:set_text(fixup_text(FixupTag), hd(AnnoL)),
+ {{string, NewAnno, String}, NewTs}.
+
+unscannable([{'#', A1}, {var, A2, 'Fun'}, {'<', A3}, {atom, A4, _},
+ {'.', A5}, {float, A6, _}, {'>', A7}|Ts]) ->
+ {[A1, A2, A3, A4, A5, A6, A7], Ts, function};
+unscannable([{'#', A1}, {var, A2, 'Fun'}, {'<', A3}, {atom, A4, _},
+ {'.', A5}, {atom, A6, _}, {'.', A7}, {integer, A8, _},
+ {'>', A9}|Ts]) ->
+ {[A1, A2, A3, A4, A5, A6, A7, A8, A9], Ts, function};
+unscannable([{'<', A1}, {float, A2, _}, {'.', A3}, {integer, A4, _},
+ {'>', A5}|Ts]) ->
+ {[A1, A2, A3, A4, A5], Ts, pid};
+unscannable([{'#', A1}, {var, A2, 'Port'}, {'<', A3}, {float, A4, _},
+ {'>', A5}|Ts]) ->
+ {[A1, A2, A3, A4, A5], Ts, port};
+unscannable([{'#', A1}, {var, A2, 'Ref'}, {'<', A3}, {float, A4, _},
+ {'.', A5}, {float, A6, _}, {'>', A7}|Ts]) ->
+ {[A1, A2, A3, A4, A5, A6, A7], Ts, reference}.
+
+expr_fixup(Expr0) ->
+ {Expr, Bs, _} = expr_fixup(Expr0, erl_eval:new_bindings(), 1),
+ {Expr, Bs}.
+
+expr_fixup({string,A,S}=T, Bs0, I) ->
+ try string_fixup(A, S) of
+ Value ->
+ Var = new_var(I),
+ Bs = erl_eval:add_binding(Var, Value, Bs0),
+ {{var, A, Var}, Bs, I+1}
+ catch
+ _:_ ->
+ {T, Bs0, I}
+ end;
+expr_fixup(Tuple, Bs0, I0) when is_tuple(Tuple) ->
+ {L, Bs, I} = expr_fixup(tuple_to_list(Tuple), Bs0, I0),
+ {list_to_tuple(L), Bs, I};
+expr_fixup([E0|Es0], Bs0, I0) ->
+ {E, Bs1, I1} = expr_fixup(E0, Bs0, I0),
+ {Es, Bs, I} = expr_fixup(Es0, Bs1, I1),
+ {[E|Es], Bs, I};
+expr_fixup(T, Bs, I) ->
+ {T, Bs, I}.
+
+string_fixup(A, S) ->
+ Text = erl_anno:text(A),
+ FixupTag = fixup_tag(Text, S),
+ (fixup_fun(FixupTag))(S).
+
+new_var(I) ->
+ list_to_atom(lists:concat(['__ExtendedParseExprs_', I, '__'])).
+
+reset_token_anno(Tokens) ->
+ [setelement(2, T, (reset_anno())(element(2, T))) || T <- Tokens].
+
+reset_expr_anno(Exprs) ->
+ [erl_parse:map_anno(reset_anno(), E) || E <- Exprs].
+
+reset_anno() ->
+ fun(A) -> erl_anno:new(erl_anno:location(A)) end.
+
+fixup_fun(function) -> fun function/1;
+fixup_fun(pid) -> fun erlang:list_to_pid/1;
+fixup_fun(port) -> fun erlang:list_to_port/1;
+fixup_fun(reference) -> fun erlang:list_to_ref/1.
+
+function(S) ->
+ %% External function.
+ {ok, [_, _, _,
+ {atom, _, Module}, _,
+ {atom, _, Function}, _,
+ {integer, _, Arity}|_], _} = erl_scan:string(S),
+ erlang:make_fun(Module, Function, Arity).
+
+fixup_text(function) -> "function";
+fixup_text(pid) -> "pid";
+fixup_text(port) -> "port";
+fixup_text(reference) -> "reference".
+
+fixup_tag("function", "#"++_) -> function;
+fixup_tag("pid", "<"++_) -> pid;
+fixup_tag("port", "#"++_) -> port;
+fixup_tag("reference", "#"++_) -> reference.
+
+%%% End of extended_parse_exprs.
+
+%% `Tokens' is assumed to have been scanned with the 'text' option.
+%%
+%% Can handle pids, ports, references, and external funs.
+
+-spec extended_parse_term(Tokens) ->
+ {'ok', Term} | {'error', ErrorInfo} when
+ Tokens :: [erl_scan:token()],
+ Term :: term(),
+ ErrorInfo :: erl_parse:error_info().
+
+extended_parse_term(Tokens) ->
+ case extended_parse_exprs(Tokens) of
+ {ok, [Expr], Bindings} ->
+ try normalise(Expr, Bindings) of
+ Term ->
+ {ok, Term}
+ catch
+ _:_ ->
+ Loc = erl_anno:location(element(2, Expr)),
+ {error,{Loc,?MODULE,"bad term"}}
+ end;
+ {ok, [_,Expr|_], _Bindings} ->
+ Loc = erl_anno:location(element(2, Expr)),
+ {error,{Loc,?MODULE,"bad term"}};
+ {error, _} = Error ->
+ Error
+ end.
+
+%% From erl_parse.
+normalise({var, _, V}, Bs) ->
+ {value, Value} = erl_eval:binding(V, Bs),
+ Value;
+normalise({char,_,C}, _Bs) -> C;
+normalise({integer,_,I}, _Bs) -> I;
+normalise({float,_,F}, _Bs) -> F;
+normalise({atom,_,A}, _Bs) -> A;
+normalise({string,_,S}, _Bs) -> S;
+normalise({nil,_}, _Bs) -> [];
+normalise({bin,_,Fs}, Bs) ->
+ {value, B, _} =
+ eval_bits:expr_grp(Fs, [],
+ fun(E, _) ->
+ {value, normalise(E, Bs), []}
+ end, [], true),
+ B;
+normalise({cons,_,Head,Tail}, Bs) ->
+ [normalise(Head, Bs)|normalise(Tail, Bs)];
+normalise({tuple,_,Args}, Bs) ->
+ list_to_tuple(normalise_list(Args, Bs));
+normalise({map,_,Pairs}, Bs) ->
+ maps:from_list(lists:map(fun
+ %% only allow '=>'
+ ({map_field_assoc,_,K,V}) ->
+ {normalise(K, Bs),normalise(V, Bs)}
+ end, Pairs));
+%% Special case for unary +/-.
+normalise({op,_,'+',{char,_,I}}, _Bs) -> I;
+normalise({op,_,'+',{integer,_,I}}, _Bs) -> I;
+normalise({op,_,'+',{float,_,F}}, _Bs) -> F;
+normalise({op,_,'-',{char,_,I}}, _Bs) -> -I; %Weird, but compatible!
+normalise({op,_,'-',{integer,_,I}}, _Bs) -> -I;
+normalise({op,_,'-',{float,_,F}}, _Bs) -> -F;
+normalise({'fun',_,{function,{atom,_,M},{atom,_,F},{integer,_,A}}}, _Bs) ->
+ %% Since "#Fun<M.F.A>" is recognized, "fun M:F/A" should be too.
+ fun M:F/A.
+
+normalise_list([H|T], Bs) ->
+ [normalise(H, Bs)|normalise_list(T, Bs)];
+normalise_list([], _Bs) ->
+ [].
+
%%----------------------------------------------------------------------------
%%
%% Evaluate expressions:
@@ -1320,13 +1566,53 @@ ev_expr({cons,_,H,T}) -> [ev_expr(H) | ev_expr(T)].
%% true = erl_internal:guard_bif(F, length(As)),
%% apply(erlang, F, [ev_expr(X) || X <- As]);
+%% eval_str(InStr) -> {ok, OutStr} | {error, ErrStr'}
+%% InStr must represent a body
+%% Note: If InStr is a binary it has to be a Latin-1 string.
+%% If you have a UTF-8 encoded binary you have to call
+%% unicode:characters_to_list/1 before the call to eval_str().
+
+-define(result(F,D), lists:flatten(io_lib:format(F, D))).
+
+-spec eval_str(string() | unicode:latin1_binary()) ->
+ {'ok', string()} | {'error', string()}.
+
+eval_str(Str) when is_list(Str) ->
+ case erl_scan:tokens([], Str, 0) of
+ {more, _} ->
+ {error, "Incomplete form (missing .<cr>)??"};
+ {done, {ok, Toks, _}, Rest} ->
+ case all_white(Rest) of
+ true ->
+ case erl_parse:parse_exprs(Toks) of
+ {ok, Exprs} ->
+ case catch erl_eval:exprs(Exprs, erl_eval:new_bindings()) of
+ {value, Val, _} ->
+ {ok, Val};
+ Other ->
+ {error, ?result("*** eval: ~p", [Other])}
+ end;
+ {error, {_Line, Mod, Args}} ->
+ Msg = ?result("*** ~ts",[Mod:format_error(Args)]),
+ {error, Msg}
+ end;
+ false ->
+ {error, ?result("Non-white space found after "
+ "end-of-form :~ts", [Rest])}
+ end
+ end;
+eval_str(Bin) when is_binary(Bin) ->
+ eval_str(binary_to_list(Bin)).
+
+all_white([$\s|T]) -> all_white(T);
+all_white([$\n|T]) -> all_white(T);
+all_white([$\t|T]) -> all_white(T);
+all_white([]) -> true;
+all_white(_) -> false.
+
ret_expr(_Old, New) ->
%% io:format("~w: reduced ~s => ~s~n",
%% [line(Old), erl_pp:expr(Old), erl_pp:expr(New)]),
New.
line(Expr) -> element(2, Expr).
-
-%% {?MODULE,expr,3} is still the stacktrace, despite the
-%% fact that expr() now takes two, three or four arguments...
-stacktrace() -> [{?MODULE,expr,3}].
diff --git a/lib/stdlib/src/erl_internal.erl b/lib/stdlib/src/erl_internal.erl
index 89b97b901e..939abaff00 100644
--- a/lib/stdlib/src/erl_internal.erl
+++ b/lib/stdlib/src/erl_internal.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1998-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1998-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -74,8 +74,10 @@ guard_bif(element, 2) -> true;
guard_bif(float, 1) -> true;
guard_bif(floor, 1) -> true;
guard_bif(hd, 1) -> true;
+guard_bif(is_map_key, 2) -> true;
guard_bif(length, 1) -> true;
guard_bif(map_size, 1) -> true;
+guard_bif(map_get, 2) -> true;
guard_bif(node, 0) -> true;
guard_bif(node, 1) -> true;
guard_bif(round, 1) -> true;
@@ -314,6 +316,7 @@ bif(is_function, 2) -> true;
bif(is_integer, 1) -> true;
bif(is_list, 1) -> true;
bif(is_map, 1) -> true;
+bif(is_map_key, 2) -> true;
bif(is_number, 1) -> true;
bif(is_pid, 1) -> true;
bif(is_port, 1) -> true;
@@ -337,6 +340,7 @@ bif(list_to_tuple, 1) -> true;
bif(load_module, 2) -> true;
bif(make_ref, 0) -> true;
bif(map_size,1) -> true;
+bif(map_get,2) -> true;
bif(max,2) -> true;
bif(min,2) -> true;
bif(module_loaded, 1) -> true;
diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl
index 9cd4727dc3..e9ac2fcdff 100644
--- a/lib/stdlib/src/erl_lint.erl
+++ b/lib/stdlib/src/erl_lint.erl
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -93,13 +93,6 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) ->
}).
-%% Are we outside or inside a catch or try/catch?
--type catch_scope() :: 'none'
- | 'after_old_catch'
- | 'after_try'
- | 'wrong_part_of_try'
- | 'try_catch'.
-
%% Define the lint state record.
%% 'called' and 'exports' contain {Line, {Function, Arity}},
%% the other function collections contain {Function, Arity}.
@@ -144,8 +137,7 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) ->
:: dict:dict(ta(), #typeinfo{}),
exp_types=gb_sets:empty() %Exported types
:: gb_sets:set(ta()),
- catch_scope = none %Inside/outside try or catch
- :: catch_scope()
+ in_try_head=false :: boolean() %In a try head.
}).
-type lint_state() :: #lint{}.
@@ -232,15 +224,6 @@ format_error({redefine_old_bif_import,{F,A}}) ->
format_error({redefine_bif_import,{F,A}}) ->
io_lib:format("import directive overrides auto-imported BIF ~w/~w~n"
" - use \"-compile({no_auto_import,[~w/~w]}).\" to resolve name clash", [F,A,F,A]);
-format_error({get_stacktrace,wrong_part_of_try}) ->
- "erlang:get_stacktrace/0 used in the wrong part of 'try' expression. "
- "(Use it in the block between 'catch' and 'end'.)";
-format_error({get_stacktrace,after_old_catch}) ->
- "erlang:get_stacktrace/0 used following an old-style 'catch' "
- "may stop working in a future release. (Use it inside 'try'.)";
-format_error({get_stacktrace,after_try}) ->
- "erlang:get_stacktrace/0 used following a 'try' expression "
- "may stop working in a future release. (Use it inside 'try'.)";
format_error({deprecated, MFA, ReplacementMFA, Rel}) ->
io_lib:format("~s is deprecated and will be removed in ~s; use ~s",
[format_mfa(MFA), Rel, format_mfa(ReplacementMFA)]);
@@ -312,6 +295,10 @@ format_error({unused_var, V}) ->
io_lib:format("variable ~w is unused", [V]);
format_error({variable_in_record_def,V}) ->
io_lib:format("variable ~w in record definition", [V]);
+format_error({stacktrace_guard,V}) ->
+ io_lib:format("stacktrace variable ~w must not be used in a guard", [V]);
+format_error({stacktrace_bound,V}) ->
+ io_lib:format("stacktrace variable ~w must not be previously bound", [V]);
%% --- binaries ---
format_error({undefined_bittype,Type}) ->
io_lib:format("bit type ~tw undefined", [Type]);
@@ -586,10 +573,7 @@ start(File, Opts) ->
false, Opts)},
{missing_spec_all,
bool_option(warn_missing_spec_all, nowarn_missing_spec_all,
- false, Opts)},
- {get_stacktrace,
- bool_option(warn_get_stacktrace, nowarn_get_stacktrace,
- true, Opts)}
+ false, Opts)}
],
Enabled1 = [Category || {Category,true} <- Enabled0],
Enabled = ordsets:from_list(Enabled1),
@@ -1421,7 +1405,7 @@ call_function(Line, F, A, #lint{usage=Usage0,called=Cd,func=Func,file=File}=St)
%% function(Line, Name, Arity, Clauses, State) -> State.
function(Line, Name, Arity, Cs, St0) ->
- St1 = St0#lint{func={Name,Arity},catch_scope=none},
+ St1 = St0#lint{func={Name,Arity}},
St2 = define_function(Line, Name, Arity, St1),
clauses(Cs, St2).
@@ -2111,6 +2095,10 @@ is_gexpr({cons,_L,H,T}, Info) -> is_gexpr_list([H,T], Info);
is_gexpr({tuple,_L,Es}, Info) -> is_gexpr_list(Es, Info);
%%is_gexpr({struct,_L,_Tag,Es}, Info) ->
%% is_gexpr_list(Es, Info);
+is_gexpr({map,_L,Es}, Info) ->
+ is_map_fields(Es, Info);
+is_gexpr({map,_L,Src,Es}, Info) ->
+ is_gexpr(Src, Info) andalso is_map_fields(Es, Info);
is_gexpr({record_index,_L,_Name,Field}, Info) ->
is_gexpr(Field, Info);
is_gexpr({record_field,_L,Rec,_Name,Field}, Info) ->
@@ -2153,6 +2141,14 @@ is_gexpr_op(Op, A) ->
is_gexpr_list(Es, Info) -> all(fun (E) -> is_gexpr(E, Info) end, Es).
+is_map_fields([{Tag,_,K,V}|Fs], Info) when Tag =:= map_field_assoc;
+ Tag =:= map_field_exact ->
+ is_gexpr(K, Info) andalso
+ is_gexpr(V, Info) andalso
+ is_map_fields(Fs, Info);
+is_map_fields([], _Info) -> true;
+is_map_fields(_T, _Info) -> false.
+
is_gexpr_fields(Fs, L, Name, {RDs,_}=Info) ->
IFs = case dict:find(Name, RDs) of
{ok,{_Line,Fields}} -> Fs ++ init_fields(Fs, L, Fields);
@@ -2362,7 +2358,7 @@ expr({call,Line,F,As}, Vt, St0) ->
expr({'try',Line,Es,Scs,Ccs,As}, Vt, St0) ->
%% Currently, we don't allow any exports because later
%% passes cannot handle exports in combination with 'after'.
- {Evt0,St1} = exprs(Es, Vt, St0#lint{catch_scope=wrong_part_of_try}),
+ {Evt0,St1} = exprs(Es, Vt, St0),
TryLine = {'try',Line},
Uvt = vtunsafe(TryLine, Evt0, Vt),
Evt1 = vtupdate(Uvt, Evt0),
@@ -2374,12 +2370,11 @@ expr({'try',Line,Es,Scs,Ccs,As}, Vt, St0) ->
{Avt0,St} = exprs(As, vtupdate(Evt2, Vt), St2),
Avt1 = vtupdate(vtunsafe(TryLine, Avt0, Vt), Avt0),
Avt = vtmerge(Evt2, Avt1),
- {Avt,St#lint{catch_scope=after_try}};
+ {Avt,St};
expr({'catch',Line,E}, Vt, St0) ->
%% No new variables added, flag new variables as unsafe.
{Evt,St} = expr(E, Vt, St0),
- {vtupdate(vtunsafe({'catch',Line}, Evt, Vt), Evt),
- St#lint{catch_scope=after_old_catch}};
+ {vtupdate(vtunsafe({'catch',Line}, Evt, Vt), Evt),St};
expr({match,_Line,P,E}, Vt, St0) ->
{Evt,St1} = expr(E, Vt, St0),
{Pvt,Bvt,St2} = pattern(P, vtupdate(Evt, Vt), St1),
@@ -3218,11 +3213,11 @@ is_module_dialyzer_option(Option) ->
try_clauses(Scs, Ccs, In, Vt, St0) ->
{Csvt0,St1} = icrt_clauses(Scs, Vt, St0),
- St2 = St1#lint{catch_scope=try_catch},
+ St2 = St1#lint{in_try_head=true},
{Csvt1,St3} = icrt_clauses(Ccs, Vt, St2),
Csvt = Csvt0 ++ Csvt1,
UpdVt = icrt_export(Csvt, Vt, In, St3),
- {UpdVt,St3}.
+ {UpdVt,St3#lint{in_try_head=false}}.
%% icrt_clauses(Clauses, In, ImportVarTable, State) ->
%% {UpdVt,State}.
@@ -3238,13 +3233,30 @@ icrt_clauses(Cs, In, Vt, St0) ->
icrt_clauses(Cs, Vt, St) ->
mapfoldl(fun (C, St0) -> icrt_clause(C, Vt, St0) end, St, Cs).
-icrt_clause({clause,_Line,H,G,B}, Vt0, #lint{catch_scope=Scope}=St0) ->
- {Hvt,Binvt,St1} = head(H, Vt0, St0),
- Vt1 = vtupdate(Hvt, Binvt),
- {Gvt,St2} = guard(G, vtupdate(Vt1, Vt0), St1),
- Vt2 = vtupdate(Gvt, Vt1),
- {Bvt,St3} = exprs(B, vtupdate(Vt2, Vt0), St2),
- {vtupdate(Bvt, Vt2),St3#lint{catch_scope=Scope}}.
+icrt_clause({clause,_Line,H,G,B}, Vt0, St0) ->
+ Vt1 = taint_stack_var(Vt0, H, St0),
+ {Hvt,Binvt,St1} = head(H, Vt1, St0),
+ Vt2 = vtupdate(Hvt, Binvt),
+ Vt3 = taint_stack_var(Vt2, H, St0),
+ {Gvt,St2} = guard(G, vtupdate(Vt3, Vt0), St1#lint{in_try_head=false}),
+ Vt4 = vtupdate(Gvt, Vt2),
+ {Bvt,St3} = exprs(B, vtupdate(Vt4, Vt0), St2),
+ {vtupdate(Bvt, Vt4),St3}.
+
+taint_stack_var(Vt, Pat, #lint{in_try_head=true}) ->
+ [{tuple,_,[_,_,{var,_,Stk}]}] = Pat,
+ case Stk of
+ '_' ->
+ Vt;
+ _ ->
+ lists:map(fun({V,{bound,Used,Lines}}) when V =:= Stk ->
+ {V,{stacktrace,Used,Lines}};
+ (B) ->
+ B
+ end, Vt)
+ end;
+taint_stack_var(Vt, _Pat, #lint{in_try_head=false}) ->
+ Vt.
icrt_export(Vts, Vt, {Tag,Attrs}, St) ->
{_File,Loc} = loc(Attrs, St),
@@ -3484,6 +3496,9 @@ pat_var(V, Line, Vt, Bvt, St) ->
{[{V,{bound,used,Ls}}],[],
%% As this is matching, exported vars are risky.
add_warning(Line, {exported_var,V,From}, St)};
+ {ok,{stacktrace,_Usage,Ls}} ->
+ {[{V,{bound,used,Ls}}],[],
+ add_error(Line, {stacktrace_bound,V}, St)};
error when St#lint.recdef_top ->
{[],[{V,{bound,unused,[Line]}}],
add_error(Line, {variable_in_record_def,V}, St)};
@@ -3541,6 +3556,9 @@ expr_var(V, Line, Vt, St) ->
false ->
{[{V,{{export,From},used,Ls}}],St}
end;
+ {ok,{stacktrace,_Usage,Ls}} ->
+ {[{V,{bound,used,Ls}}],
+ add_error(Line, {stacktrace_guard,V}, St)};
error ->
{[{V,{bound,used,[Line]}}],
add_error(Line, {unbound_var,V}, St)}
@@ -3708,8 +3726,7 @@ has_wildcard_field([]) -> false.
check_remote_function(Line, M, F, As, St0) ->
St1 = deprecated_function(Line, M, F, As, St0),
St2 = check_qlc_hrl(Line, M, F, As, St1),
- St3 = check_get_stacktrace(Line, M, F, As, St2),
- format_function(Line, M, F, As, St3).
+ format_function(Line, M, F, As, St2).
%% check_qlc_hrl(Line, ModName, FuncName, [Arg], State) -> State
%% Add warning if qlc:q/1,2 has been called but qlc.hrl has not
@@ -3758,23 +3775,6 @@ deprecated_function(Line, M, F, As, St) ->
St
end.
-check_get_stacktrace(Line, erlang, get_stacktrace, [], St) ->
- case St of
- #lint{catch_scope=none} ->
- St;
- #lint{catch_scope=try_catch} ->
- St;
- #lint{catch_scope=Scope} ->
- case is_warn_enabled(get_stacktrace, St) of
- false ->
- St;
- true ->
- add_warning(Line, {get_stacktrace,Scope}, St)
- end
- end;
-check_get_stacktrace(_, _, _, _, St) ->
- St.
-
-dialyzer({no_match, deprecated_type/5}).
deprecated_type(L, M, N, As, St) ->
@@ -3910,10 +3910,9 @@ check_format_string(Fmt) ->
extract_sequences(Fmt, []).
extract_sequences(Fmt, Need0) ->
- case string:chr(Fmt, $~) of
- 0 -> {ok,lists:reverse(Need0)}; %That's it
- Pos ->
- Fmt1 = string:substr(Fmt, Pos+1), %Skip ~
+ case string:find(Fmt, [$~]) of
+ nomatch -> {ok,lists:reverse(Need0)}; %That's it
+ [$~|Fmt1] ->
case extract_sequence(1, Fmt1, Need0) of
{ok,Need1,Rest} -> extract_sequences(Rest, Need1);
Error -> Error
@@ -3944,6 +3943,8 @@ extract_sequence(3, [$.,_|Fmt], Need) ->
extract_sequence(4, Fmt, Need);
extract_sequence(3, Fmt, Need) ->
extract_sequence(4, Fmt, Need);
+extract_sequence(4, [$t, $l | Fmt], Need) ->
+ extract_sequence(4, [$l, $t | Fmt], Need);
extract_sequence(4, [$t, $c | Fmt], Need) ->
extract_sequence(5, [$c|Fmt], Need);
extract_sequence(4, [$t, $s | Fmt], Need) ->
@@ -3960,8 +3961,14 @@ extract_sequence(4, [$t, C | _Fmt], _Need) ->
{error,"invalid control ~t" ++ [C]};
extract_sequence(4, [$l, $p | Fmt], Need) ->
extract_sequence(5, [$p|Fmt], Need);
+extract_sequence(4, [$l, $t, $p | Fmt], Need) ->
+ extract_sequence(5, [$p|Fmt], Need);
extract_sequence(4, [$l, $P | Fmt], Need) ->
extract_sequence(5, [$P|Fmt], Need);
+extract_sequence(4, [$l, $t, $P | Fmt], Need) ->
+ extract_sequence(5, [$P|Fmt], Need);
+extract_sequence(4, [$l, $t, C | _Fmt], _Need) ->
+ {error,"invalid control ~lt" ++ [C]};
extract_sequence(4, [$l, C | _Fmt], _Need) ->
{error,"invalid control ~l" ++ [C]};
extract_sequence(4, Fmt, Need) ->
diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl
index 6e72d64acc..9602f0bcd9 100644
--- a/lib/stdlib/src/erl_parse.yrl
+++ b/lib/stdlib/src/erl_parse.yrl
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -29,6 +29,10 @@ clause_args clause_guard clause_body
expr expr_100 expr_150 expr_160 expr_200 expr_300 expr_400 expr_500
expr_600 expr_700 expr_800
expr_max
+pat_expr pat_expr_200 pat_expr_300 pat_expr_400 pat_expr_500
+pat_expr_600 pat_expr_700 pat_expr_800
+pat_expr_max map_pat_expr record_pat_expr
+pat_argument_list pat_exprs
list tail
list_comprehension lc_expr lc_exprs
binary_comprehension
@@ -37,7 +41,7 @@ record_expr record_tuple record_field record_fields
map_expr map_tuple map_field map_field_assoc map_field_exact map_fields map_key
if_expr if_clause if_clauses case_expr cr_clause cr_clauses receive_expr
fun_expr fun_clause fun_clauses atom_or_var integer_or_var
-try_expr try_catch try_clause try_clauses
+try_expr try_catch try_clause try_clauses try_opt_stacktrace
function_call argument_list
exprs guard
atomic strings
@@ -66,7 +70,7 @@ char integer float atom string var
'spec' 'callback' % helper
dot.
-Expect 2.
+Expect 0.
Rootsymbol form.
@@ -210,7 +214,7 @@ function_clause -> atom clause_args clause_guard clause_body :
{clause,?anno('$1'),element(3, '$1'),'$2','$3','$4'}.
-clause_args -> argument_list : element(1, '$1').
+clause_args -> pat_argument_list : element(1, '$1').
clause_guard -> 'when' guard : '$2'.
clause_guard -> '$empty' : [].
@@ -275,6 +279,53 @@ expr_max -> receive_expr : '$1'.
expr_max -> fun_expr : '$1'.
expr_max -> try_expr : '$1'.
+pat_expr -> pat_expr_200 '=' pat_expr : {match,?anno('$2'),'$1','$3'}.
+pat_expr -> pat_expr_200 : '$1'.
+
+pat_expr_200 -> pat_expr_300 comp_op pat_expr_300 :
+ ?mkop2('$1', '$2', '$3').
+pat_expr_200 -> pat_expr_300 : '$1'.
+
+pat_expr_300 -> pat_expr_400 list_op pat_expr_300 :
+ ?mkop2('$1', '$2', '$3').
+pat_expr_300 -> pat_expr_400 : '$1'.
+
+pat_expr_400 -> pat_expr_400 add_op pat_expr_500 :
+ ?mkop2('$1', '$2', '$3').
+pat_expr_400 -> pat_expr_500 : '$1'.
+
+pat_expr_500 -> pat_expr_500 mult_op pat_expr_600 :
+ ?mkop2('$1', '$2', '$3').
+pat_expr_500 -> pat_expr_600 : '$1'.
+
+pat_expr_600 -> prefix_op pat_expr_700 :
+ ?mkop1('$1', '$2').
+pat_expr_600 -> map_pat_expr : '$1'.
+pat_expr_600 -> pat_expr_700 : '$1'.
+
+pat_expr_700 -> record_pat_expr : '$1'.
+pat_expr_700 -> pat_expr_800 : '$1'.
+
+pat_expr_800 -> pat_expr_max : '$1'.
+
+pat_expr_max -> var : '$1'.
+pat_expr_max -> atomic : '$1'.
+pat_expr_max -> list : '$1'.
+pat_expr_max -> binary : '$1'.
+pat_expr_max -> tuple : '$1'.
+pat_expr_max -> '(' pat_expr ')' : '$2'.
+
+map_pat_expr -> '#' map_tuple :
+ {map, ?anno('$1'),'$2'}.
+map_pat_expr -> pat_expr_max '#' map_tuple :
+ {map, ?anno('$2'),'$1','$3'}.
+map_pat_expr -> map_pat_expr '#' map_tuple :
+ {map, ?anno('$2'),'$1','$3'}.
+
+record_pat_expr -> '#' atom '.' atom :
+ {record_index,?anno('$1'),element(3, '$2'),'$4'}.
+record_pat_expr -> '#' atom record_tuple :
+ {record,?anno('$1'),element(3, '$2'),'$3'}.
list -> '[' ']' : {nil,?anno('$1')}.
list -> '[' expr tail : {cons,?anno('$1'),'$2','$3'}.
@@ -397,6 +448,10 @@ case_expr -> 'case' expr 'of' cr_clauses 'end' :
cr_clauses -> cr_clause : ['$1'].
cr_clauses -> cr_clause ';' cr_clauses : ['$1' | '$3'].
+%% FIXME: merl in syntax_tools depends on patterns in a 'case' being
+%% full expressions. Therefore, we can't use pat_expr here. There
+%% should be a better way.
+
cr_clause -> expr clause_guard clause_body :
{clause,?anno('$1'),['$1'],'$2','$3'}.
@@ -424,11 +479,11 @@ integer_or_var -> var : '$1'.
fun_clauses -> fun_clause : ['$1'].
fun_clauses -> fun_clause ';' fun_clauses : ['$1' | '$3'].
-fun_clause -> argument_list clause_guard clause_body :
+fun_clause -> pat_argument_list clause_guard clause_body :
{Args,Anno} = '$1',
{clause,Anno,'fun',Args,'$2','$3'}.
-fun_clause -> var argument_list clause_guard clause_body :
+fun_clause -> var pat_argument_list clause_guard clause_body :
{clause,element(2, '$1'),element(3, '$1'),element(1, '$2'),'$3','$4'}.
try_expr -> 'try' exprs 'of' cr_clauses try_catch :
@@ -446,24 +501,31 @@ try_catch -> 'after' exprs 'end' :
try_clauses -> try_clause : ['$1'].
try_clauses -> try_clause ';' try_clauses : ['$1' | '$3'].
-try_clause -> expr clause_guard clause_body :
+try_clause -> pat_expr clause_guard clause_body :
A = ?anno('$1'),
{clause,A,[{tuple,A,[{atom,A,throw},'$1',{var,A,'_'}]}],'$2','$3'}.
-try_clause -> atom ':' expr clause_guard clause_body :
+try_clause -> atom ':' pat_expr try_opt_stacktrace clause_guard clause_body :
A = ?anno('$1'),
- {clause,A,[{tuple,A,['$1','$3',{var,A,'_'}]}],'$4','$5'}.
-try_clause -> var ':' expr clause_guard clause_body :
+ {clause,A,[{tuple,A,['$1','$3',{var,A,'$4'}]}],'$5','$6'}.
+try_clause -> var ':' pat_expr try_opt_stacktrace clause_guard clause_body :
A = ?anno('$1'),
- {clause,A,[{tuple,A,['$1','$3',{var,A,'_'}]}],'$4','$5'}.
+ {clause,A,[{tuple,A,['$1','$3',{var,A,'$4'}]}],'$5','$6'}.
+try_opt_stacktrace -> ':' var : element(3, '$2').
+try_opt_stacktrace -> '$empty' : '_'.
argument_list -> '(' ')' : {[],?anno('$1')}.
argument_list -> '(' exprs ')' : {'$2',?anno('$1')}.
+pat_argument_list -> '(' ')' : {[],?anno('$1')}.
+pat_argument_list -> '(' pat_exprs ')' : {'$2',?anno('$1')}.
exprs -> expr : ['$1'].
exprs -> expr ',' exprs : ['$1' | '$3'].
+pat_exprs -> pat_expr : ['$1'].
+pat_exprs -> pat_expr ',' pat_exprs : ['$1' | '$3'].
+
guard -> exprs : ['$1'].
guard -> exprs ';' guard : ['$1'|'$3'].
@@ -918,7 +980,7 @@ Erlang code.
-type af_unary_op(T) :: {'op', anno(), unary_op(), T}.
--type unary_op() :: '+' | '*' | 'bnot' | 'not'.
+-type unary_op() :: '+' | '-' | 'bnot' | 'not'.
%% See also lib/stdlib/{src/erl_bits.erl,include/erl_bits.hrl}.
-type type_specifier_list() :: 'default' | [type_specifier(), ...].
@@ -1315,6 +1377,8 @@ normalise({map,_,Pairs}=M) ->
({map_field_assoc,_,K,V}) -> {normalise(K),normalise(V)};
(_) -> erlang:error({badarg,M})
end, Pairs));
+normalise({'fun',_,{function,{atom,_,M},{atom,_,F},{integer,_,A}}}) ->
+ fun M:F/A;
%% Special case for unary +/-.
normalise({op,_,'+',{char,_,I}}) -> I;
normalise({op,_,'+',{integer,_,I}}) -> I;
diff --git a/lib/stdlib/src/erl_posix_msg.erl b/lib/stdlib/src/erl_posix_msg.erl
index bfafca1ff7..8959fea498 100644
--- a/lib/stdlib/src/erl_posix_msg.erl
+++ b/lib/stdlib/src/erl_posix_msg.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -64,6 +64,7 @@ message_1(eduppkg) -> <<"duplicate package name">>;
message_1(eexist) -> <<"file already exists">>;
message_1(efault) -> <<"bad address in system call argument">>;
message_1(efbig) -> <<"file too large">>;
+message_1(eftype) -> <<"EFTYPE">>;
message_1(ehostdown) -> <<"host is down">>;
message_1(ehostunreach) -> <<"host is unreachable">>;
message_1(eidrm) -> <<"identifier removed">>;
@@ -115,6 +116,7 @@ message_1(enopkg) -> <<"package not installed">>;
message_1(enoprotoopt) -> <<"bad proocol option">>;
message_1(enospc) -> <<"no space left on device">>;
message_1(enosr) -> <<"out of stream resources or not a stream device">>;
+message_1(enostr) -> <<"not a stream">>;
message_1(enosym) -> <<"unresolved symbol name">>;
message_1(enosys) -> <<"function not implemented">>;
message_1(enotblk) -> <<"block device required">>;
@@ -128,6 +130,7 @@ message_1(enotty) -> <<"inappropriate device for ioctl">>;
message_1(enotuniq) -> <<"name not unique on network">>;
message_1(enxio) -> <<"no such device or address">>;
message_1(eopnotsupp) -> <<"operation not supported on socket">>;
+message_1(eoverflow) -> <<"offset too large for file system">>;
message_1(eperm) -> <<"not owner">>;
message_1(epfnosupport) -> <<"protocol family not supported">>;
message_1(epipe) -> <<"broken pipe">>;
@@ -167,4 +170,6 @@ message_1(ewouldblock) -> <<"operation would block">>;
message_1(exdev) -> <<"cross-domain link">>;
message_1(exfull) -> <<"message tables full">>;
message_1(nxdomain) -> <<"non-existing domain">>;
+message_1(exbadport) -> <<"inet_drv bad port state">>;
+message_1(exbadseq) -> <<"inet_drv bad request sequence">>;
message_1(_) -> <<"unknown POSIX error">>.
diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl
index ee5e7a11bf..dd302a2880 100644
--- a/lib/stdlib/src/erl_pp.erl
+++ b/lib/stdlib/src/erl_pp.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -59,7 +59,7 @@
_ -> ?TEST(T)
end).
-define(EXPRS_TEST(L),
- [?TEST(E) || E <- L]).
+ _ = [?TEST(E) || E <- L]).
-define(TEST(T),
%% Assumes that erl_anno has been compiled with DEBUG=true.
%% erl_pp does not use the annoations, but test it anyway.
@@ -237,13 +237,20 @@ lform({attribute,Line,Name,Arg}, Opts) ->
lform({function,Line,Name,Arity,Clauses}, Opts) ->
lfunction({function,Line,Name,Arity,Clauses}, Opts);
%% These are specials to make it easier for the compiler.
-lform({error,E}, _Opts) ->
- leaf(format("~p\n", [{error,E}]));
-lform({warning,W}, _Opts) ->
- leaf(format("~p\n", [{warning,W}]));
+lform({error,_}=E, Opts) ->
+ message(E, Opts);
+lform({warning,_}=W, Opts) ->
+ message(W, Opts);
lform({eof,_Line}, _Opts) ->
$\n.
+message(M, #options{encoding = Encoding}) ->
+ F = case Encoding of
+ latin1 -> "~p\n";
+ unicode -> "~tp\n"
+ end,
+ leaf(format(F, [M])).
+
lattribute({attribute,_Line,type,Type}, Opts) ->
[typeattr(type, Type, Opts),leaf(".\n")];
lattribute({attribute,_Line,opaque,Type}, Opts) ->
@@ -598,8 +605,6 @@ lexpr({'fun',_,{clauses,Cs},Extra}, _Prec, Opts) ->
lexpr({named_fun,_,Name,Cs,Extra}, _Prec, Opts) ->
{force_nl,fun_info(Extra),
{list,[{first,['fun', " "],fun_clauses(Cs, Opts, {named, Name})},'end']}};
-lexpr({'query',_,Lc}, _Prec, Opts) ->
- {list,[{step,leaf("query"),lexpr(Lc, 0, Opts)},'end']};
lexpr({call,_,{remote,_,{atom,_,M},{atom,_,F}=N}=Name,Args}, Prec, Opts) ->
case erl_internal:bif(M, F, length(Args)) of
true ->
@@ -904,7 +909,7 @@ maybe_paren(_P, _Prec, Expr) ->
Expr.
leaf(S) ->
- {leaf,chars_size(S),S}.
+ {leaf,string:length(S),S}.
%%% Do the formatting. Currently nothing fancy. Could probably have
%%% done it in one single pass.
@@ -964,7 +969,7 @@ f({seq,Before,After,Sep,LItems}, I0, ST, WT, PP) ->
Sizes = BSizeL ++ SizeL,
NSepChars = if
is_list(Sep), Sep =/= [] ->
- erlang:max(0, length(CharsL)-1);
+ erlang:max(0, length(CharsL)-1); % not string:length
true ->
0
end,
@@ -1120,7 +1125,7 @@ incr(I, Incr) ->
I+Incr.
indentation(E, I) when I < 0 ->
- chars_size(E);
+ string:length(E);
indentation(E, I0) ->
I = io_lib_format:indentation(E, I0),
case has_nl(E) of
@@ -1157,19 +1162,19 @@ write_a_string(S, I, PP) ->
write_a_string([], _N, _Len, _PP) ->
[];
write_a_string(S, N, Len, PP) ->
- SS = string:sub_string(S, 1, N),
+ SS = string:slice(S, 0, N),
Sl = write_string(SS, PP),
- case (chars_size(Sl) > Len) and (N > ?MIN_SUBSTRING) of
+ case (string:length(Sl) > Len) and (N > ?MIN_SUBSTRING) of
true ->
write_a_string(S, N-1, Len, PP);
false ->
[flat_leaf(Sl) |
- write_a_string(lists:nthtail(length(SS), S), Len, Len, PP)]
+ write_a_string(string:slice(S, string:length(SS)), Len, Len, PP)]
end.
flat_leaf(S) ->
L = lists:flatten(S),
- {leaf,length(L),L}.
+ {leaf,string:length(L),L}.
write_value(V, PP) ->
(PP#pp.value_fun)(V).
@@ -1190,15 +1195,6 @@ write_char(C, PP) ->
a0() ->
erl_anno:new(0).
-chars_size([C | Es]) when is_integer(C) ->
- 1 + chars_size(Es);
-chars_size([E | Es]) ->
- chars_size(E) + chars_size(Es);
-chars_size([]) ->
- 0;
-chars_size(B) when is_binary(B) ->
- byte_size(B).
-
-define(N_SPACES, 30).
spacetab() ->
diff --git a/lib/stdlib/src/erl_scan.erl b/lib/stdlib/src/erl_scan.erl
index 47223b129c..4774c4bf19 100644
--- a/lib/stdlib/src/erl_scan.erl
+++ b/lib/stdlib/src/erl_scan.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2015. 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.
@@ -752,7 +752,7 @@ scan_string(Cs, St, Line, Col, Toks, {Wcs,Str,Line0,Col0}) ->
{char_error,Ncs,Error,Nline,Ncol,EndCol} ->
scan_error(Error, Nline, Ncol, Nline, EndCol, Ncs);
{error,Nline,Ncol,Nwcs,Ncs} ->
- Estr = string:substr(Nwcs, 1, 16), % Expanded escape chars.
+ Estr = string:slice(Nwcs, 0, 16), % Expanded escape chars.
scan_error({string,$\",Estr}, Line0, Col0, Nline, Ncol, Ncs); %"
{Ncs,Nline,Ncol,Nstr,Nwcs} ->
Anno = anno(Line0, Col0, St, Nstr),
@@ -767,7 +767,7 @@ scan_qatom(Cs, St, Line, Col, Toks, {Wcs,Str,Line0,Col0}) ->
{char_error,Ncs,Error,Nline,Ncol,EndCol} ->
scan_error(Error, Nline, Ncol, Nline, EndCol, Ncs);
{error,Nline,Ncol,Nwcs,Ncs} ->
- Estr = string:substr(Nwcs, 1, 16), % Expanded escape chars.
+ Estr = string:slice(Nwcs, 0, 16), % Expanded escape chars.
scan_error({string,$\',Estr}, Line0, Col0, Nline, Ncol, Ncs); %'
{Ncs,Nline,Ncol,Nstr,Nwcs} ->
case catch list_to_atom(Nwcs) of
diff --git a/lib/stdlib/src/erl_tar.erl b/lib/stdlib/src/erl_tar.erl
index 5ee584d612..d8b8f466b1 100644
--- a/lib/stdlib/src/erl_tar.erl
+++ b/lib/stdlib/src/erl_tar.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -457,26 +457,61 @@ add(Reader, NameOrBin, NameInArchive, Options)
do_add(#reader{access=write}=Reader, Name, NameInArchive, Options)
when is_list(NameInArchive), is_list(Options) ->
- RF = fun(F) -> file:read_link_info(F, [{time, posix}]) end,
+ RF = apply_file_info_opts_fun(Options, read_link_info),
Opts = #add_opts{read_info=RF},
- add1(Reader, Name, NameInArchive, add_opts(Options, Opts));
+ add1(Reader, Name, NameInArchive, add_opts(Options, Options, Opts));
do_add(#reader{access=read},_,_,_) ->
{error, eacces};
do_add(Reader,_,_,_) ->
{error, {badarg, Reader}}.
-add_opts([dereference|T], Opts) ->
- RF = fun(F) -> file:read_file_info(F, [{time, posix}]) end,
- add_opts(T, Opts#add_opts{read_info=RF});
-add_opts([verbose|T], Opts) ->
- add_opts(T, Opts#add_opts{verbose=true});
-add_opts([{chunks,N}|T], Opts) ->
- add_opts(T, Opts#add_opts{chunk_size=N});
-add_opts([_|T], Opts) ->
- add_opts(T, Opts);
-add_opts([], Opts) ->
+add_opts([dereference|T], AllOptions, Opts) ->
+ RF = apply_file_info_opts_fun(AllOptions, read_file_info),
+ add_opts(T, AllOptions, Opts#add_opts{read_info=RF});
+add_opts([verbose|T], AllOptions, Opts) ->
+ add_opts(T, AllOptions, Opts#add_opts{verbose=true});
+add_opts([{chunks,N}|T], AllOptions, Opts) ->
+ add_opts(T, AllOptions, Opts#add_opts{chunk_size=N});
+add_opts([{atime,Value}|T], AllOptions, Opts) ->
+ add_opts(T, AllOptions, Opts#add_opts{atime=Value});
+add_opts([{mtime,Value}|T], AllOptions, Opts) ->
+ add_opts(T, AllOptions, Opts#add_opts{mtime=Value});
+add_opts([{ctime,Value}|T], AllOptions, Opts) ->
+ add_opts(T, AllOptions, Opts#add_opts{ctime=Value});
+add_opts([{uid,Value}|T], AllOptions, Opts) ->
+ add_opts(T, AllOptions, Opts#add_opts{uid=Value});
+add_opts([{gid,Value}|T], AllOptions, Opts) ->
+ add_opts(T, AllOptions, Opts#add_opts{gid=Value});
+add_opts([_|T], AllOptions, Opts) ->
+ add_opts(T, AllOptions, Opts);
+add_opts([], _AllOptions, Opts) ->
Opts.
+apply_file_info_opts(Opts, {ok, FileInfo}) ->
+ {ok, do_apply_file_info_opts(Opts, FileInfo)};
+apply_file_info_opts(_Opts, Other) ->
+ Other.
+
+do_apply_file_info_opts([{atime,Value}|T], FileInfo) ->
+ do_apply_file_info_opts(T, FileInfo#file_info{atime=Value});
+do_apply_file_info_opts([{mtime,Value}|T], FileInfo) ->
+ do_apply_file_info_opts(T, FileInfo#file_info{mtime=Value});
+do_apply_file_info_opts([{ctime,Value}|T], FileInfo) ->
+ do_apply_file_info_opts(T, FileInfo#file_info{ctime=Value});
+do_apply_file_info_opts([{uid,Value}|T], FileInfo) ->
+ do_apply_file_info_opts(T, FileInfo#file_info{uid=Value});
+do_apply_file_info_opts([{gid,Value}|T], FileInfo) ->
+ do_apply_file_info_opts(T, FileInfo#file_info{gid=Value});
+do_apply_file_info_opts([_|T], FileInfo) ->
+ do_apply_file_info_opts(T, FileInfo);
+do_apply_file_info_opts([], FileInfo) ->
+ FileInfo.
+
+apply_file_info_opts_fun(Options, InfoFunction) ->
+ fun(F) ->
+ apply_file_info_opts(Options, file:InfoFunction(F, [{time, posix}]))
+ end.
+
add1(#reader{}=Reader, Name, NameInArchive, #add_opts{read_info=ReadInfo}=Opts)
when is_list(Name) ->
Res = case ReadInfo(Name) of
@@ -515,9 +550,11 @@ add1(Reader, Bin, NameInArchive, Opts) when is_binary(Bin) ->
name = NameInArchive,
size = byte_size(Bin),
typeflag = ?TYPE_REGULAR,
- atime = Now,
- mtime = Now,
- ctime = Now,
+ atime = add_opts_time(Opts#add_opts.atime, Now),
+ mtime = add_opts_time(Opts#add_opts.mtime, Now),
+ ctime = add_opts_time(Opts#add_opts.ctime, Now),
+ uid = Opts#add_opts.uid,
+ gid = Opts#add_opts.gid,
mode = 8#100644},
{ok, Reader2} = add_header(Reader, Header, Opts),
Padding = skip_padding(byte_size(Bin)),
@@ -527,6 +564,9 @@ add1(Reader, Bin, NameInArchive, Opts) when is_binary(Bin) ->
{error, Reason} -> {error, {NameInArchive, Reason}}
end.
+add_opts_time(undefined, Now) -> Now;
+add_opts_time(Time, _Now) -> Time.
+
add_directory(Reader, DirName, NameInArchive, Info, Opts) ->
case file:list_dir(DirName) of
{ok, []} ->
@@ -1650,8 +1690,12 @@ write_file(Name, Bin) ->
case file:write_file(Name, Bin) of
ok -> ok;
{error,enoent} ->
- ok = make_dirs(Name, file),
- write_file(Name, Bin);
+ case make_dirs(Name, file) of
+ ok ->
+ write_file(Name, Bin);
+ {error,Reason} ->
+ throw({error, Reason})
+ end;
{error,Reason} ->
throw({error, Reason})
end.
diff --git a/lib/stdlib/src/erl_tar.hrl b/lib/stdlib/src/erl_tar.hrl
index cff0c2f500..5d6cecbb66 100644
--- a/lib/stdlib/src/erl_tar.hrl
+++ b/lib/stdlib/src/erl_tar.hrl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2017. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -21,7 +21,12 @@
-record(add_opts, {
read_info, %% Fun to use for read file/link info.
chunk_size = 0, %% For file reading when sending to sftp. 0=do not chunk
- verbose = false}). %% Verbose on/off.
+ verbose = false, %% Verbose on/off.
+ atime = undefined,
+ mtime = undefined,
+ ctime = undefined,
+ uid = 0,
+ gid = 0}).
-type add_opts() :: #add_opts{}.
%% Options used when reading a tar archive.
@@ -36,7 +41,12 @@
-type add_opt() :: dereference |
verbose |
- {chunks, pos_integer()}.
+ {chunks, pos_integer()} |
+ {atime, non_neg_integer()} |
+ {mtime, non_neg_integer()} |
+ {ctime, non_neg_integer()} |
+ {uid, non_neg_integer()} |
+ {gid, non_neg_integer()}.
-type extract_opt() :: {cwd, string()} |
{files, [string()]} |
diff --git a/lib/stdlib/src/escript.erl b/lib/stdlib/src/escript.erl
index 2b9d8ff65b..3f14894b55 100644
--- a/lib/stdlib/src/escript.erl
+++ b/lib/stdlib/src/escript.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2017. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -224,8 +224,8 @@ return_sections(S, Bin) ->
normalize_section(Name, undefined) ->
{Name, undefined};
normalize_section(shebang, "#!" ++ Chars) ->
- Chopped = string:strip(Chars, right, $\n),
- Stripped = string:strip(Chopped, both),
+ Chopped = string:trim(Chars, trailing, "$\n"),
+ Stripped = string:trim(Chopped, both),
if
Stripped =:= ?SHEBANG ->
{shebang, default};
@@ -233,8 +233,8 @@ normalize_section(shebang, "#!" ++ Chars) ->
{shebang, Stripped}
end;
normalize_section(comment, Chars) ->
- Chopped = string:strip(Chars, right, $\n),
- Stripped = string:strip(string:strip(Chopped, left, $%), both),
+ Chopped = string:trim(Chars, trailing, "$\n"),
+ Stripped = string:trim(string:trim(Chopped, leading, "$%"), both),
if
Stripped =:= ?COMMENT ->
{comment, default};
@@ -242,8 +242,8 @@ normalize_section(comment, Chars) ->
{comment, Stripped}
end;
normalize_section(emu_args, "%%!" ++ Chars) ->
- Chopped = string:strip(Chars, right, $\n),
- Stripped = string:strip(Chopped, both),
+ Chopped = string:trim(Chars, trailing, "$\n"),
+ Stripped = string:trim(Chopped, both),
{emu_args, Stripped};
normalize_section(Name, Chars) ->
{Name, Chars}.
@@ -283,8 +283,7 @@ start(EscriptOptions) ->
throw:Str ->
io:format("escript: ~ts\n", [Str]),
my_halt(127);
- _:Reason ->
- Stk = erlang:get_stacktrace(),
+ _:Reason:Stk ->
io:format("escript: Internal error: ~tp\n", [Reason]),
io:format("~tp\n", [Stk]),
my_halt(127)
@@ -759,8 +758,8 @@ run(Module, Args) ->
Module:main(Args),
my_halt(0)
catch
- Class:Reason ->
- fatal(format_exception(Class, Reason))
+ Class:Reason:StackTrace ->
+ fatal(format_exception(Class, Reason, StackTrace))
end.
-spec interpret(_, _, _, _) -> no_return().
@@ -793,8 +792,8 @@ interpret(Forms, HasRecs, File, Args) ->
end}),
my_halt(0)
catch
- Class:Reason ->
- fatal(format_exception(Class, Reason))
+ Class:Reason:StackTrace ->
+ fatal(format_exception(Class, Reason, StackTrace))
end.
report_errors(Errors) ->
@@ -873,7 +872,7 @@ eval_exprs([E|Es], Bs0, Lf, Ef, RBs) ->
{value,_V,Bs} = erl_eval:expr(E, Bs0, Lf, Ef, RBs1),
eval_exprs(Es, Bs, Lf, Ef, RBs).
-format_exception(Class, Reason) ->
+format_exception(Class, Reason, StackTrace) ->
Enc = encoding(),
P = case Enc of
latin1 -> "P";
@@ -882,9 +881,8 @@ format_exception(Class, Reason) ->
PF = fun(Term, I) ->
io_lib:format("~." ++ integer_to_list(I) ++ P, [Term, 50])
end,
- StackTrace = erlang:get_stacktrace(),
StackFun = fun(M, _F, _A) -> (M =:= erl_eval) or (M =:= ?MODULE) end,
- lib:format_exception(1, Class, Reason, StackTrace, StackFun, PF, Enc).
+ erl_error:format_exception(1, Class, Reason, StackTrace, StackFun, PF, Enc).
encoding() ->
[{encoding, Encoding}] = enc(),
@@ -916,8 +914,8 @@ hidden_apply(App, M, F, Args) ->
try
apply(fun() -> M end(), F, Args)
catch
- error:undef ->
- case erlang:get_stacktrace() of
+ error:undef:StackTrace ->
+ case StackTrace of
[{M,F,Args,_} | _] ->
Arity = length(Args),
Text = io_lib:format("Call to ~w:~w/~w in application ~w failed.\n",
diff --git a/lib/stdlib/src/ets.erl b/lib/stdlib/src/ets.erl
index 42fa8ede92..29f907ad73 100644
--- a/lib/stdlib/src/ets.erl
+++ b/lib/stdlib/src/ets.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -73,10 +73,13 @@
select_count/2, select_delete/2, select_replace/2, select_reverse/1,
select_reverse/2, select_reverse/3, setopts/2, slot/2,
take/2,
- update_counter/3, update_counter/4, update_element/3]).
+ update_counter/3, update_counter/4, update_element/3,
+ whereis/1]).
%% internal exports
--export([internal_request_all/0]).
+-export([internal_request_all/0,
+ internal_delete_all/2,
+ internal_select_delete/2]).
-spec all() -> [Tab] when
Tab :: tab().
@@ -115,7 +118,15 @@ delete(_, _) ->
-spec delete_all_objects(Tab) -> true when
Tab :: tab().
-delete_all_objects(_) ->
+delete_all_objects(Tab) ->
+ _ = ets:internal_delete_all(Tab, undefined),
+ true.
+
+-spec internal_delete_all(Tab, undefined) -> NumDeleted when
+ Tab :: tab(),
+ NumDeleted :: non_neg_integer().
+
+internal_delete_all(_, _) ->
erlang:nif_error(undef).
-spec delete_object(Tab, Object) -> true when
@@ -145,6 +156,7 @@ give_away(_, _, _) ->
InfoList :: [InfoTuple],
InfoTuple :: {compressed, boolean()}
| {heir, pid() | none}
+ | {id, tid()}
| {keypos, pos_integer()}
| {memory, non_neg_integer()}
| {name, atom()}
@@ -162,7 +174,7 @@ info(_) ->
-spec info(Tab, Item) -> Value | undefined when
Tab :: tab(),
- Item :: compressed | fixed | heir | keypos | memory
+ Item :: compressed | fixed | heir | id | keypos | memory
| name | named_table | node | owner | protection
| safe_fixed | safe_fixed_monotonic_time | size | stats | type
| write_concurrency | read_concurrency,
@@ -376,7 +388,17 @@ select_count(_, _) ->
MatchSpec :: match_spec(),
NumDeleted :: non_neg_integer().
-select_delete(_, _) ->
+select_delete(Tab, [{'_',[],[true]}]) ->
+ ets:internal_delete_all(Tab, undefined);
+select_delete(Tab, MatchSpec) ->
+ ets:internal_select_delete(Tab, MatchSpec).
+
+-spec internal_select_delete(Tab, MatchSpec) -> NumDeleted when
+ Tab :: tab(),
+ MatchSpec :: match_spec(),
+ NumDeleted :: non_neg_integer().
+
+internal_select_delete(_, _) ->
erlang:nif_error(undef).
-spec select_replace(Tab, MatchSpec) -> NumReplaced when
@@ -512,6 +534,11 @@ update_counter(_, _, _, _) ->
update_element(_, _, _) ->
erlang:nif_error(undef).
+-spec whereis(TableName) -> tid() | undefined when
+ TableName :: atom().
+whereis(_) ->
+ erlang:nif_error(undef).
+
%%% End of BIFs
-opaque comp_match_spec() :: reference().
@@ -882,10 +909,10 @@ tab2file(Tab, File, Options) ->
_ = disk_log:close(Name),
_ = file:delete(File),
exit(ExReason);
- error:ErReason ->
+ error:ErReason:StackTrace ->
_ = disk_log:close(Name),
_ = file:delete(File),
- erlang:raise(error,ErReason,erlang:get_stacktrace())
+ erlang:raise(error,ErReason,StackTrace)
end
catch
throw:TReason2 ->
@@ -1060,9 +1087,9 @@ file2tab(File, Opts) ->
exit:ExReason ->
ets:delete(Tab),
exit(ExReason);
- error:ErReason ->
+ error:ErReason:StackTrace ->
ets:delete(Tab),
- erlang:raise(error,ErReason,erlang:get_stacktrace())
+ erlang:raise(error,ErReason,StackTrace)
end
after
_ = disk_log:close(Name)
@@ -1719,7 +1746,7 @@ get_line(P, Default) ->
line_string(Binary) when is_binary(Binary) -> unicode:characters_to_list(Binary);
line_string(Other) -> Other.
-nonl(S) -> string:strip(S, right, $\n).
+nonl(S) -> string:trim(S, trailing, "$\n").
print_number(Tab, Key, Num) ->
Os = ets:lookup(Tab, Key),
@@ -1748,7 +1775,7 @@ do_display_item(_Height, Width, I, Opos) ->
L = to_string(I),
L2 = if
length(L) > Width - 8 ->
- string:substr(L, 1, Width-13) ++ " ...";
+ string:slice(L, 0, Width-13) ++ " ...";
true ->
L
end,
diff --git a/lib/stdlib/src/eval_bits.erl b/lib/stdlib/src/eval_bits.erl
index 631faa3be5..bb86a65c72 100644
--- a/lib/stdlib/src/eval_bits.erl
+++ b/lib/stdlib/src/eval_bits.erl
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -25,6 +25,9 @@
-export([expr_grp/3,expr_grp/5,match_bits/6,
match_bits/7,bin_gen/6]).
+-define(STACKTRACE,
+ element(2, erlang:process_info(self(), current_stacktrace))).
+
%% Types used in this module:
%% @type bindings(). An abstract structure for bindings between
%% variables and values (the environment)
@@ -93,9 +96,9 @@ eval_exp_field1(V, Size, Unit, Type, Endian, Sign) ->
eval_exp_field(V, Size, Unit, Type, Endian, Sign)
catch
error:system_limit ->
- error(system_limit);
+ erlang:raise(error, system_limit, ?STACKTRACE);
error:_ ->
- error(badarg)
+ erlang:raise(error, badarg, ?STACKTRACE)
end.
eval_exp_field(Val, Size, Unit, integer, little, signed) ->
@@ -131,7 +134,7 @@ eval_exp_field(Val, all, Unit, binary, _, _) ->
Size when Size rem Unit =:= 0 ->
<<Val:Size/binary-unit:1>>;
_ ->
- error(badarg)
+ erlang:raise(error, badarg, ?STACKTRACE)
end;
eval_exp_field(Val, Size, Unit, binary, _, _) ->
<<Val:(Size*Unit)/binary-unit:1>>.
@@ -377,12 +380,12 @@ make_bit_type(Line, default, Type0) ->
{ok,all,Bt} -> {{atom,Line,all},erl_bits:as_list(Bt)};
{ok,undefined,Bt} -> {{atom,Line,undefined},erl_bits:as_list(Bt)};
{ok,Size,Bt} -> {{integer,Line,Size},erl_bits:as_list(Bt)};
- {error,Reason} -> error(Reason)
+ {error,Reason} -> erlang:raise(error, Reason, ?STACKTRACE)
end;
make_bit_type(_Line, Size, Type0) -> %Size evaluates to an integer or 'all'
case erl_bits:set_bit_type(Size, Type0) of
{ok,Size,Bt} -> {Size,erl_bits:as_list(Bt)};
- {error,Reason} -> error(Reason)
+ {error,Reason} -> erlang:raise(error, Reason, ?STACKTRACE)
end.
match_check_size(Mfun, Size, Bs) ->
@@ -405,9 +408,3 @@ match_check_size(_, {value,_,_}, _Bs, _AllowAll) ->
ok; %From the debugger.
match_check_size(_, _, _Bs, _AllowAll) ->
throw(invalid).
-
-%% error(Reason) -> exception thrown
-%% Throw a nice-looking exception, similar to exceptions from erl_eval.
-error(Reason) ->
- erlang:raise(error, Reason, [{erl_eval,expr,3}]).
-
diff --git a/lib/stdlib/src/file_sorter.erl b/lib/stdlib/src/file_sorter.erl
index 3aeaff8dc4..191e050538 100644
--- a/lib/stdlib/src/file_sorter.erl
+++ b/lib/stdlib/src/file_sorter.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2001-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2001-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -1314,9 +1314,9 @@ infun(W) ->
{cont, W#w{in = NFun}, Objs};
Error ->
error(Error, W1)
- catch Class:Reason ->
+ catch Class:Reason:Stacktrace ->
cleanup(W1),
- erlang:raise(Class, Reason, erlang:get_stacktrace())
+ erlang:raise(Class, Reason, Stacktrace)
end.
outfun(A, #w{inout_value = Val} = W) when Val =/= no_value ->
@@ -1336,9 +1336,9 @@ outfun(A, W) ->
W#w{out = NF};
Error ->
error(Error, W1)
- catch Class:Reason ->
+ catch Class:Reason:Stacktrace ->
cleanup(W1),
- erlang:raise(Class, Reason, erlang:get_stacktrace())
+ erlang:raise(Class, Reason, Stacktrace)
end.
is_keypos(Keypos) when is_integer(Keypos), Keypos > 0 ->
diff --git a/lib/stdlib/src/filelib.erl b/lib/stdlib/src/filelib.erl
index a9c055f72d..de839be5cf 100644
--- a/lib/stdlib/src/filelib.erl
+++ b/lib/stdlib/src/filelib.erl
@@ -365,11 +365,18 @@ do_list_dir(Dir, Mod) -> eval_list_dir(Dir, Mod).
%%% Compiling a wildcard.
+
+%% Define characters used for escaping a \.
+-define(ESCAPE_PREFIX, $@).
+-define(ESCAPE_CHARACTER, [?ESCAPE_PREFIX,$e]).
+-define(ESCAPED_ESCAPE_PREFIX, [?ESCAPE_PREFIX,?ESCAPE_PREFIX]).
+
%% Only for debugging.
compile_wildcard(Pattern) when is_list(Pattern) ->
{compiled_wildcard,?HANDLE_ERROR(compile_wildcard(Pattern, "."))}.
-compile_wildcard(Pattern, Cwd0) ->
+compile_wildcard(Pattern0, Cwd0) ->
+ Pattern = convert_escapes(Pattern0),
[Root|Rest] = filename:split(Pattern),
case filename:pathtype(Root) of
relative ->
@@ -409,7 +416,8 @@ compile_join({cwd,Cwd}, File0) ->
compile_join({root,PrefixLen,Root}, File) ->
{root,PrefixLen,filename:join(Root, File)}.
-compile_part(Part) ->
+compile_part(Part0) ->
+ Part = wrap_escapes(Part0),
compile_part(Part, false, []).
compile_part_to_sep(Part) ->
@@ -445,6 +453,8 @@ compile_part([${|Rest], Upto, Result) ->
error ->
compile_part(Rest, Upto, [${|Result])
end;
+compile_part([{escaped,X}|Rest], Upto, Result) ->
+ compile_part(Rest, Upto, [X|Result]);
compile_part([X|Rest], Upto, Result) ->
compile_part(Rest, Upto, [X|Result]);
compile_part([], _Upto, Result) ->
@@ -461,6 +471,8 @@ compile_charset1([Lower, $-, Upper|Rest], Ordset) when Lower =< Upper ->
compile_charset1(Rest, compile_range(Lower, Upper, Ordset));
compile_charset1([$]|Rest], Ordset) ->
{ok, {one_of, gb_sets:from_ordset(Ordset)}, Rest};
+compile_charset1([{escaped,X}|Rest], Ordset) ->
+ compile_charset1(Rest, ordsets:add_element(X, Ordset));
compile_charset1([X|Rest], Ordset) ->
compile_charset1(Rest, ordsets:add_element(X, Ordset));
compile_charset1([], _Ordset) ->
@@ -486,6 +498,32 @@ compile_alt(Pattern, Result) ->
error
end.
+%% Convert backslashes to an illegal Unicode character to
+%% protect in from filename:split/1.
+
+convert_escapes([?ESCAPE_PREFIX|T]) ->
+ ?ESCAPED_ESCAPE_PREFIX ++ convert_escapes(T);
+convert_escapes([$\\|T]) ->
+ ?ESCAPE_CHARACTER ++ convert_escapes(T);
+convert_escapes([H|T]) ->
+ [H|convert_escapes(T)];
+convert_escapes([]) ->
+ [].
+
+%% Wrap each escape in a tuple to remove the special meaning for
+%% the character that follows.
+
+wrap_escapes(?ESCAPED_ESCAPE_PREFIX ++ T) ->
+ [?ESCAPE_PREFIX|wrap_escapes(T)];
+wrap_escapes(?ESCAPE_CHARACTER ++ [C|T]) ->
+ [{escaped,C}|wrap_escapes(T)];
+wrap_escapes(?ESCAPE_CHARACTER) ->
+ [];
+wrap_escapes([H|T]) ->
+ [H|wrap_escapes(T)];
+wrap_escapes([]) ->
+ [].
+
badpattern(Reason) ->
error({badpattern,Reason}).
diff --git a/lib/stdlib/src/filename.erl b/lib/stdlib/src/filename.erl
index ee807dfd09..b7b7b562ab 100644
--- a/lib/stdlib/src/filename.erl
+++ b/lib/stdlib/src/filename.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -34,6 +34,38 @@
%% we flatten the arguments immediately on function entry as that makes
%% it easier to ensure that the code works.
+%%
+%% *** Requirements on Raw Filename Format ***
+%%
+%% These requirements are due to the 'filename' module
+%% in stdlib. This since it is documented that it
+%% should be able to operate on raw filenames as well
+%% as ordinary filenames.
+%%
+%% A raw filename *must* be a byte sequence where:
+%% 1. Codepoints 0-127 (7-bit ascii) *must* be encoded
+%% as a byte with the corresponding value. That is,
+%% the most significant bit in the byte encoding the
+%% codepoint is never set.
+%% 2. Codepoints greater than 127 *must* be encoded
+%% with the most significant bit set in *every* byte
+%% encoding it.
+%%
+%% Latin1 and UTF-8 meet these requirements while
+%% UTF-16 and UTF-32 don't.
+%%
+%% On Windows filenames are natively stored as malformed
+%% UTF-16LE (lonely surrogates may appear). A more correct
+%% description than UTF-16 would be an array of 16-bit
+%% words... In order to meet the requirements of the
+%% raw file format we convert the malformed UTF-16LE to
+%% malformed UTF-8 which meet the requirements.
+%%
+%% Note that these requirements are today only OTP
+%% internal (erts-stdlib internal) requirements that
+%% could be changed.
+%%
+
-export([absname/1, absname/2, absname_join/2,
basename/1, basename/2, dirname/1,
extension/1, join/1, join/2, pathtype/1,
@@ -41,6 +73,7 @@
safe_relative_path/1]).
-export([find_src/1, find_src/2]). % deprecated
-export([basedir/2, basedir/3]).
+-export([validate/1]).
%% Undocumented and unsupported exports.
-export([append/2]).
@@ -979,24 +1012,33 @@ filename_string_to_binary(List) ->
%% basedir
%% http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html
--type basedir_type() :: 'user_cache' | 'user_config' | 'user_data'
- | 'user_log'
- | 'site_config' | 'site_data'.
+-type basedir_path_type() :: 'user_cache' | 'user_config' | 'user_data'
+ | 'user_log'.
+-type basedir_paths_type() :: 'site_config' | 'site_data'.
+
+-type basedir_opts() :: #{author => string() | binary(),
+ os => 'windows' | 'darwin' | 'linux',
+ version => string() | binary()}.
--spec basedir(Type,Application) -> file:filename_all() when
- Type :: basedir_type(),
+-spec basedir(PathType,Application) -> file:filename_all() when
+ PathType :: basedir_path_type(),
+ Application :: string() | binary();
+ (PathsType,Application) -> [file:filename_all()] when
+ PathsType :: basedir_paths_type(),
Application :: string() | binary().
basedir(Type,Application) when is_atom(Type), is_list(Application) orelse
is_binary(Application) ->
basedir(Type, Application, #{}).
--spec basedir(Type,Application,Opts) -> file:filename_all() when
- Type :: basedir_type(),
+-spec basedir(PathType,Application,Opts) -> file:filename_all() when
+ PathType :: basedir_path_type(),
Application :: string() | binary(),
- Opts :: #{author => string() | binary(),
- os => 'windows' | 'darwin' | 'linux',
- version => string() | binary()}.
+ Opts :: basedir_opts();
+ (PathsType,Application,Opts) -> [file:filename_all()] when
+ PathsType :: basedir_paths_type(),
+ Application :: string() | binary(),
+ Opts :: basedir_opts().
basedir(Type,Application,Opts) when is_atom(Type), is_map(Opts),
is_list(Application) orelse
@@ -1053,10 +1095,10 @@ basedir_linux(Type) ->
user_log -> getenv("XDG_CACHE_HOME", ?basedir_linux_user_log, true);
site_data ->
Base = getenv("XDG_DATA_DIRS",?basedir_linux_site_data,false),
- string:tokens(Base,":");
+ string:lexemes(Base, ":");
site_config ->
Base = getenv("XDG_CONFIG_DIRS",?basedir_linux_site_config,false),
- string:tokens(Base,":")
+ string:lexemes(Base, ":")
end.
-define(basedir_darwin_user_data, "Library/Application Support").
@@ -1152,3 +1194,72 @@ basedir_os_type() ->
{win32,_} -> windows;
_ -> linux
end.
+
+%%
+%% validate/1
+%%
+
+-spec validate(FileName) -> boolean() when
+ FileName :: file:name_all().
+
+validate(FileName) when is_binary(FileName) ->
+ %% Raw filename...
+ validate_bin(FileName);
+validate(FileName) when is_list(FileName);
+ is_atom(FileName) ->
+ validate_list(FileName,
+ file:native_name_encoding(),
+ os:type()).
+
+validate_list(FileName, Enc, Os) ->
+ try
+ true = validate_list(FileName, Enc, Os, 0) > 0
+ catch
+ _ : _ -> false
+ end.
+
+validate_list([], _Enc, _Os, Chars) ->
+ Chars;
+validate_list(C, Enc, Os, Chars) when is_integer(C) ->
+ validate_char(C, Enc, Os),
+ Chars+1;
+validate_list(A, Enc, Os, Chars) when is_atom(A) ->
+ validate_list(atom_to_list(A), Enc, Os, Chars);
+validate_list([H|T], Enc, Os, Chars) ->
+ NewChars = validate_list(H, Enc, Os, Chars),
+ validate_list(T, Enc, Os, NewChars).
+
+%% C is always an integer...
+% validate_char(C, _, _) when not is_integer(C) ->
+% throw(invalid);
+validate_char(C, _, _) when C < 1 ->
+ throw(invalid); %% No negative or null characters...
+validate_char(C, latin1, _) when C > 255 ->
+ throw(invalid);
+validate_char(C, utf8, _) when C >= 16#110000 ->
+ throw(invalid);
+validate_char(C, utf8, {win32, _}) when C > 16#ffff ->
+ throw(invalid); %% invalid win wchar...
+validate_char(_C, utf8, {win32, _}) ->
+ ok; %% Range below is accepted on windows...
+validate_char(C, utf8, _) when 16#D800 =< C, C =< 16#DFFF ->
+ throw(invalid); %% invalid unicode range...
+validate_char(_, _, _) ->
+ ok.
+
+validate_bin(Bin) ->
+ %% Raw filename. That is, we do not interpret
+ %% the encoding, but we still do not accept
+ %% null characters...
+ try
+ true = validate_bin(Bin, 0) > 0
+ catch
+ _ : _ -> false
+ end.
+
+validate_bin(<<>>, Bs) ->
+ Bs;
+validate_bin(<<0, _Rest/binary>>, _Bs) ->
+ throw(invalid); %% No null characters allowed...
+validate_bin(<<_B, Rest/binary>>, Bs) ->
+ validate_bin(Rest, Bs+1).
diff --git a/lib/stdlib/src/gen.erl b/lib/stdlib/src/gen.erl
index 33af0aed8f..a7f743bd4c 100644
--- a/lib/stdlib/src/gen.erl
+++ b/lib/stdlib/src/gen.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -49,6 +49,7 @@
| {'logfile', string()}.
-type option() :: {'timeout', timeout()}
| {'debug', [debug_flag()]}
+ | {'hibernate_after', timeout()}
| {'spawn_opt', [proc_lib:spawn_option()]}.
-type options() :: [option()].
@@ -147,57 +148,36 @@ init_it2(GenMod, Starter, Parent, Name, Mod, Args, Options) ->
call(Process, Label, Request) ->
call(Process, Label, Request, ?default_timeout).
+%% Optimize a common case.
+call(Process, Label, Request, Timeout) when is_pid(Process),
+ Timeout =:= infinity orelse is_integer(Timeout) andalso Timeout >= 0 ->
+ do_call(Process, Label, Request, Timeout);
call(Process, Label, Request, Timeout)
when Timeout =:= infinity; is_integer(Timeout), Timeout >= 0 ->
Fun = fun(Pid) -> do_call(Pid, Label, Request, Timeout) end,
do_for_proc(Process, Fun).
-do_call(Process, Label, Request, Timeout) ->
- try erlang:monitor(process, Process) of
- Mref ->
- %% If the monitor/2 call failed to set up a connection to a
- %% remote node, we don't want the '!' operator to attempt
- %% to set up the connection again. (If the monitor/2 call
- %% failed due to an expired timeout, '!' too would probably
- %% have to wait for the timeout to expire.) Therefore,
- %% use erlang:send/3 with the 'noconnect' option so that it
- %% will fail immediately if there is no connection to the
- %% remote node.
-
- catch erlang:send(Process, {Label, {self(), Mref}, Request},
- [noconnect]),
- receive
- {Mref, Reply} ->
- erlang:demonitor(Mref, [flush]),
- {ok, Reply};
- {'DOWN', Mref, _, _, noconnection} ->
- Node = get_node(Process),
- exit({nodedown, Node});
- {'DOWN', Mref, _, _, Reason} ->
- exit(Reason)
- after Timeout ->
- erlang:demonitor(Mref, [flush]),
- exit(timeout)
- end
- catch
- error:_ ->
- %% Node (C/Java?) is not supporting the monitor.
- %% The other possible case -- this node is not distributed
- %% -- should have been handled earlier.
- %% Do the best possible with monitor_node/2.
- %% This code may hang indefinitely if the Process
- %% does not exist. It is only used for featureweak remote nodes.
- Node = get_node(Process),
- monitor_node(Node, true),
- receive
- {nodedown, Node} ->
- monitor_node(Node, false),
- exit({nodedown, Node})
- after 0 ->
- Tag = make_ref(),
- Process ! {Label, {self(), Tag}, Request},
- wait_resp(Node, Tag, Timeout)
- end
+do_call(Process, Label, Request, Timeout) when is_atom(Process) =:= false ->
+ Mref = erlang:monitor(process, Process),
+
+ %% OTP-21:
+ %% Auto-connect is asynchronous. But we still use 'noconnect' to make sure
+ %% we send on the monitored connection, and not trigger a new auto-connect.
+ %%
+ erlang:send(Process, {Label, {self(), Mref}, Request}, [noconnect]),
+
+ receive
+ {Mref, Reply} ->
+ erlang:demonitor(Mref, [flush]),
+ {ok, Reply};
+ {'DOWN', Mref, _, _, noconnection} ->
+ Node = get_node(Process),
+ exit({nodedown, Node});
+ {'DOWN', Mref, _, _, Reason} ->
+ exit(Reason)
+ after Timeout ->
+ erlang:demonitor(Mref, [flush]),
+ exit(timeout)
end.
get_node(Process) ->
@@ -212,19 +192,6 @@ get_node(Process) ->
node(Process)
end.
-wait_resp(Node, Tag, Timeout) ->
- receive
- {Tag, Reply} ->
- monitor_node(Node, false),
- {ok, Reply};
- {nodedown, Node} ->
- monitor_node(Node, false),
- exit({nodedown, Node})
- after Timeout ->
- monitor_node(Node, false),
- exit(timeout)
- end.
-
%%
%% Send a reply to the client.
%%
diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl
index 73e4457bd0..8213282867 100644
--- a/lib/stdlib/src/gen_event.erl
+++ b/lib/stdlib/src/gen_event.erl
@@ -47,16 +47,19 @@
system_replace_state/2,
format_status/2]).
+%% logger callback
+-export([format_log/1]).
+
-export_type([handler/0, handler_args/0, add_handler_ret/0,
del_handler_ret/0]).
--import(error_logger, [error_msg/2]).
-
-record(handler, {module :: atom(),
id = false,
state,
supervised = false :: 'false' | pid()}).
+-include("logger.hrl").
+
%%%=========================================================================
%%% API
%%%=========================================================================
@@ -119,7 +122,7 @@
-type add_handler_ret() :: ok | term() | {'EXIT',term()}.
-type del_handler_ret() :: ok | term() | {'EXIT',term()}.
--type emgr_name() :: {'local', atom()} | {'global', atom()}
+-type emgr_name() :: {'local', atom()} | {'global', term()}
| {'via', atom(), term()}.
-type debug_flag() :: 'trace' | 'log' | 'statistics' | 'debug'
| {'logfile', string()}.
@@ -127,7 +130,7 @@
| {'debug', [debug_flag()]}
| {'spawn_opt', [proc_lib:spawn_option()]}
| {'hibernate_after', timeout()}.
--type emgr_ref() :: atom() | {atom(), atom()} | {'global', atom()}
+-type emgr_ref() :: atom() | {atom(), atom()} | {'global', term()}
| {'via', atom(), term()} | pid().
-type start_ret() :: {'ok', pid()} | {'error', term()}.
@@ -143,7 +146,7 @@
%% start_link()
%% start_link(MgrName | Options)
%% start_link(MgrName, Options)
-%% MgrName ::= {local, atom()} | {global, atom()} | {via, atom(), term()}
+%% MgrName ::= {local, atom()} | {global, term()} | {via, atom(), term()}
%% Options ::= [{timeout, Timeout} | {debug, [Flag]} | {spawn_opt,SOpts}]
%% Flag ::= trace | log | {logfile, File} | statistics | debug
%% (debug == log && statistics)
@@ -583,9 +586,13 @@ server_update(Handler1, Func, Event, SName) ->
remove, SName, normal),
no;
{'EXIT', {undef, [{Mod1, handle_info, [_,_], _}|_]}} ->
- error_logger:warning_msg("** Undefined handle_info in ~tp~n"
- "** Unhandled message: ~tp~n", [Mod1, Event]),
- {ok, Handler1};
+ ?LOG_WARNING(#{label=>{gen_event,no_handle_info},
+ module=>Mod1,
+ message=>Event},
+ #{domain=>[otp],
+ report_cb=>fun gen_event:format_log/1,
+ error_logger=>#{tag=>warning_msg}}), % warningmap??
+ {ok, Handler1};
Other ->
do_terminate(Mod1, Handler1, {error, Other}, State,
Event, SName, crash),
@@ -737,6 +744,23 @@ report_error(_Handler, normal, _, _, _) -> ok;
report_error(_Handler, shutdown, _, _, _) -> ok;
report_error(_Handler, {swapped,_,_}, _, _, _) -> ok;
report_error(Handler, Reason, State, LastIn, SName) ->
+ ?LOG_ERROR(#{label=>{gen_event,terminate},
+ handler=>handler(Handler),
+ name=>SName,
+ last_message=>LastIn,
+ state=>format_status(terminate,Handler#handler.module,
+ get(),State),
+ reason=>Reason},
+ #{domain=>[otp],
+ report_cb=>fun gen_event:format_log/1,
+ error_logger=>#{tag=>error}}).
+
+format_log(#{label:={gen_event,terminate},
+ handler:=Handler,
+ name:=SName,
+ last_message:=LastIn,
+ state:=State,
+ reason:=Reason}) ->
Reason1 =
case Reason of
{'EXIT',{undef,[{M,F,A,L}|MFAs]}} ->
@@ -756,23 +780,18 @@ report_error(Handler, Reason, State, LastIn, SName) ->
_ ->
Reason
end,
- Mod = Handler#handler.module,
- FmtState = case erlang:function_exported(Mod, format_status, 2) of
- true ->
- Args = [get(), State],
- case catch Mod:format_status(terminate, Args) of
- {'EXIT', _} -> State;
- Else -> Else
- end;
- _ ->
- State
- end,
- error_msg("** gen_event handler ~p crashed.~n"
- "** Was installed in ~tp~n"
- "** Last event was: ~tp~n"
- "** When handler state == ~tp~n"
- "** Reason == ~tp~n",
- [handler(Handler),SName,LastIn,FmtState,Reason1]).
+ {"** gen_event handler ~p crashed.~n"
+ "** Was installed in ~tp~n"
+ "** Last event was: ~tp~n"
+ "** When handler state == ~tp~n"
+ "** Reason == ~tp~n",
+ [Handler,SName,LastIn,State,Reason1]};
+format_log(#{label:={gen_event,no_handle_info},
+ module:=Mod,
+ message:=Msg}) ->
+ {"** Undefined handle_info in ~tp~n"
+ "** Unhandled message: ~tp~n",
+ [Mod, Msg]}.
handler(Handler) when not Handler#handler.id ->
Handler#handler.module;
@@ -805,17 +824,21 @@ format_status(Opt, StatusData) ->
[PDict, SysState, Parent, _Debug, [ServerName, MSL, _HibernateAfterTimeout, _Hib]] = StatusData,
Header = gen:format_status_header("Status for event handler",
ServerName),
- FmtMSL = [case erlang:function_exported(Mod, format_status, 2) of
- true ->
- Args = [PDict, State],
- case catch Mod:format_status(Opt, Args) of
- {'EXIT', _} -> MSL;
- Else -> MS#handler{state = Else}
- end;
- _ ->
- MS
- end || #handler{module = Mod, state = State} = MS <- MSL],
+ FmtMSL = [MS#handler{state=format_status(Opt, Mod, PDict, State)}
+ || #handler{module = Mod, state = State} = MS <- MSL],
[{header, Header},
{data, [{"Status", SysState},
{"Parent", Parent}]},
{items, {"Installed handlers", FmtMSL}}].
+
+format_status(Opt, Mod, PDict, State) ->
+ case erlang:function_exported(Mod, format_status, 2) of
+ true ->
+ Args = [PDict, State],
+ case catch Mod:format_status(Opt, Args) of
+ {'EXIT', _} -> State;
+ Else -> Else
+ end;
+ false ->
+ State
+ end.
diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl
index 8c7db65563..caaaf8fa2e 100644
--- a/lib/stdlib/src/gen_fsm.erl
+++ b/lib/stdlib/src/gen_fsm.erl
@@ -105,6 +105,8 @@
%%%
%%% ---------------------------------------------------
+-include("logger.hrl").
+
-export([start/3, start/4,
start_link/3, start_link/4,
stop/1, stop/3,
@@ -124,27 +126,28 @@
system_replace_state/2,
format_status/2]).
--deprecated({start, 3, next_major_release}).
--deprecated({start, 4, next_major_release}).
--deprecated({start_link, 3, next_major_release}).
--deprecated({start_link, 4, next_major_release}).
--deprecated({stop, 1, next_major_release}).
--deprecated({stop, 3, next_major_release}).
--deprecated({send_event, 2, next_major_release}).
--deprecated({sync_send_event, 2, next_major_release}).
--deprecated({sync_send_event, 3, next_major_release}).
--deprecated({send_all_state_event, 2, next_major_release}).
--deprecated({sync_send_all_state_event, 2, next_major_release}).
--deprecated({sync_send_all_state_event, 3, next_major_release}).
--deprecated({reply, 2, next_major_release}).
--deprecated({start_timer, 2, next_major_release}).
--deprecated({send_event_after, 2, next_major_release}).
--deprecated({cancel_timer, 1, next_major_release}).
--deprecated({enter_loop, 4, next_major_release}).
--deprecated({enter_loop, 5, next_major_release}).
--deprecated({enter_loop, 6, next_major_release}).
-
--import(error_logger, [format/2]).
+%% logger callback
+-export([format_log/1]).
+
+-deprecated({start, 3, eventually}).
+-deprecated({start, 4, eventually}).
+-deprecated({start_link, 3, eventually}).
+-deprecated({start_link, 4, eventually}).
+-deprecated({stop, 1, eventually}).
+-deprecated({stop, 3, eventually}).
+-deprecated({send_event, 2, eventually}).
+-deprecated({sync_send_event, 2, eventually}).
+-deprecated({sync_send_event, 3, eventually}).
+-deprecated({send_all_state_event, 2, eventually}).
+-deprecated({sync_send_all_state_event, 2, eventually}).
+-deprecated({sync_send_all_state_event, 3, eventually}).
+-deprecated({reply, 2, eventually}).
+-deprecated({start_timer, 2, eventually}).
+-deprecated({send_event_after, 2, eventually}).
+-deprecated({cancel_timer, 1, eventually}).
+-deprecated({enter_loop, 4, eventually}).
+-deprecated({enter_loop, 5, eventually}).
+-deprecated({enter_loop, 6, eventually}).
%%% ---------------------------------------------------
%%% Interface functions.
@@ -499,8 +502,12 @@ handle_msg(Msg, Parent, Name, StateName, StateData, Mod, _Time, HibernateAfterTi
reply(From, Reply),
exit(R);
{'EXIT', {undef, [{Mod, handle_info, [_,_,_], _}|_]}} ->
- error_logger:warning_msg("** Undefined handle_info in ~p~n"
- "** Unhandled message: ~tp~n", [Mod, Msg]),
+ ?LOG_WARNING(#{label=>{gen_fsm,no_handle_info},
+ module=>Mod,
+ message=>Msg},
+ #{domain=>[otp],
+ report_cb=>fun gen_fsm:format_log/1,
+ error_logger=>#{tag=>warning_msg}}),
loop(Parent, Name, StateName, StateData, Mod, infinity, HibernateAfterTimeout, []);
{'EXIT', What} ->
terminate(What, Name, Msg, Mod, StateName, StateData, []);
@@ -603,6 +610,24 @@ terminate(Reason, Name, Msg, Mod, StateName, StateData, Debug) ->
end.
error_info(Reason, Name, Msg, StateName, StateData, Debug) ->
+ ?LOG_ERROR(#{label=>{gen_fsm,terminate},
+ name=>Name,
+ last_message=>Msg,
+ state_name=>StateName,
+ state_data=>StateData,
+ reason=>Reason},
+ #{domain=>[otp],
+ report_cb=>fun gen_fsm:format_log/1,
+ error_logger=>#{tag=>error}}),
+ sys:print_log(Debug),
+ ok.
+
+format_log(#{label:={gen_fsm,terminate},
+ name:=Name,
+ last_message:=Msg,
+ state_name:=StateName,
+ state_data:=StateData,
+ reason:=Reason}) ->
Reason1 =
case Reason of
{undef,[{M,F,A,L}|MFAs]} ->
@@ -620,14 +645,18 @@ error_info(Reason, Name, Msg, StateName, StateData, Debug) ->
_ ->
Reason
end,
- Str = "** State machine ~tp terminating \n" ++
- get_msg_str(Msg) ++
- "** When State == ~tp~n"
- "** Data == ~tp~n"
- "** Reason for termination = ~n** ~tp~n",
- format(Str, [Name, get_msg(Msg), StateName, StateData, Reason1]),
- sys:print_log(Debug),
- ok.
+ {"** State machine ~tp terminating \n" ++
+ get_msg_str(Msg) ++
+ "** When State == ~tp~n"
+ "** Data == ~tp~n"
+ "** Reason for termination = ~n** ~tp~n",
+ [Name, get_msg(Msg), StateName, StateData, Reason1]};
+format_log(#{label:={gen_fsm,no_handle_info},
+ module:=Mod,
+ message:=Msg}) ->
+ {"** Undefined handle_info in ~p~n"
+ "** Unhandled message: ~tp~n",
+ [Mod, Msg]}.
get_msg_str({'$gen_event', _Event}) ->
"** Last event in was ~tp~n";
diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl
index 7daa7a9fe4..44e9231ebe 100644
--- a/lib/stdlib/src/gen_server.erl
+++ b/lib/stdlib/src/gen_server.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -104,35 +104,44 @@
system_replace_state/2,
format_status/2]).
+%% logger callback
+-export([format_log/1]).
+
%% Internal exports
-export([init_it/6]).
+-include("logger.hrl").
+
-define(
STACKTRACE(),
- try throw(ok) catch _ -> erlang:get_stacktrace() end).
+ element(2, erlang:process_info(self(), current_stacktrace))).
%%%=========================================================================
%%% API
%%%=========================================================================
-callback init(Args :: term()) ->
- {ok, State :: term()} | {ok, State :: term(), timeout() | hibernate} |
+ {ok, State :: term()} | {ok, State :: term(), timeout() | hibernate | {continue, term()}} |
{stop, Reason :: term()} | ignore.
-callback handle_call(Request :: term(), From :: {pid(), Tag :: term()},
State :: term()) ->
{reply, Reply :: term(), NewState :: term()} |
- {reply, Reply :: term(), NewState :: term(), timeout() | hibernate} |
+ {reply, Reply :: term(), NewState :: term(), timeout() | hibernate | {continue, term()}} |
{noreply, NewState :: term()} |
- {noreply, NewState :: term(), timeout() | hibernate} |
+ {noreply, NewState :: term(), timeout() | hibernate | {continue, term()}} |
{stop, Reason :: term(), Reply :: term(), NewState :: term()} |
{stop, Reason :: term(), NewState :: term()}.
-callback handle_cast(Request :: term(), State :: term()) ->
{noreply, NewState :: term()} |
- {noreply, NewState :: term(), timeout() | hibernate} |
+ {noreply, NewState :: term(), timeout() | hibernate | {continue, term()}} |
{stop, Reason :: term(), NewState :: term()}.
-callback handle_info(Info :: timeout | term(), State :: term()) ->
{noreply, NewState :: term()} |
- {noreply, NewState :: term(), timeout() | hibernate} |
+ {noreply, NewState :: term(), timeout() | hibernate | {continue, term()}} |
+ {stop, Reason :: term(), NewState :: term()}.
+-callback handle_continue(Info :: term(), State :: term()) ->
+ {noreply, NewState :: term()} |
+ {noreply, NewState :: term(), timeout() | hibernate | {continue, term()}} |
{stop, Reason :: term(), NewState :: term()}.
-callback terminate(Reason :: (normal | shutdown | {shutdown, term()} |
term()),
@@ -149,7 +158,7 @@
Status :: term().
-optional_callbacks(
- [handle_info/2, terminate/2, code_change/3, format_status/2]).
+ [handle_info/2, handle_continue/2, terminate/2, code_change/3, format_status/2]).
%%% -----------------------------------------------------------------
%%% Starts a generic server.
@@ -157,7 +166,7 @@
%%% start(Name, Mod, Args, Options)
%%% start_link(Mod, Args, Options)
%%% start_link(Name, Mod, Args, Options) where:
-%%% Name ::= {local, atom()} | {global, atom()} | {via, atom(), term()}
+%%% Name ::= {local, atom()} | {global, term()} | {via, atom(), term()}
%%% Mod ::= atom(), callback module implementing the 'real' server
%%% Args ::= term(), init arguments (to Mod:init/1)
%%% Options ::= [{timeout, Timeout} | {debug, [Flag]}]
@@ -309,7 +318,7 @@ enter_loop(Mod, Options, State, ServerName, Timeout) ->
Name = gen:get_proc_name(ServerName),
Parent = gen:get_parent(),
Debug = gen:debug_options(Name, Options),
- HibernateAfterTimeout = gen:hibernate_after(Options),
+ HibernateAfterTimeout = gen:hibernate_after(Options),
loop(Parent, Name, State, Mod, Timeout, HibernateAfterTimeout, Debug).
%%%========================================================================
@@ -365,7 +374,7 @@ init_it(Mod, Args) ->
{ok, Mod:init(Args)}
catch
throw:R -> {ok, R};
- Class:R -> {'EXIT', Class, R, erlang:get_stacktrace()}
+ Class:R:S -> {'EXIT', Class, R, S}
end.
%%%========================================================================
@@ -374,6 +383,19 @@ init_it(Mod, Args) ->
%%% ---------------------------------------------------
%%% The MAIN loop.
%%% ---------------------------------------------------
+
+loop(Parent, Name, State, Mod, {continue, Continue} = Msg, HibernateAfterTimeout, Debug) ->
+ Reply = try_dispatch(Mod, handle_continue, Continue, State),
+ case Debug of
+ [] ->
+ handle_common_reply(Reply, Parent, Name, undefined, Msg, Mod,
+ HibernateAfterTimeout, State);
+ _ ->
+ Debug1 = sys:handle_debug(Debug, fun print_event/3, Name, Msg),
+ handle_common_reply(Reply, Parent, Name, undefined, Msg, Mod,
+ HibernateAfterTimeout, State, Debug1)
+ end;
+
loop(Parent, Name, State, Mod, hibernate, HibernateAfterTimeout, Debug) ->
proc_lib:hibernate(?MODULE,wake_hib,[Parent, Name, State, Mod, HibernateAfterTimeout, Debug]);
@@ -420,12 +442,11 @@ decode_msg(Msg, Parent, Name, State, Mod, Time, HibernateAfterTimeout, Debug, Hi
%%% Send/receive functions
%%% ---------------------------------------------------
do_send(Dest, Msg) ->
- case catch erlang:send(Dest, Msg, [noconnect]) of
- noconnect ->
- spawn(erlang, send, [Dest,Msg]);
- Other ->
- Other
- end.
+ try erlang:send(Dest, Msg)
+ catch
+ error:_ -> ok
+ end,
+ ok.
do_multi_call(Nodes, Name, Req, infinity) ->
Tag = make_ref(),
@@ -617,18 +638,22 @@ try_dispatch(Mod, Func, Msg, State) ->
catch
throw:R ->
{ok, R};
- error:undef = R when Func == handle_info ->
+ error:undef = R:Stacktrace when Func == handle_info ->
case erlang:function_exported(Mod, handle_info, 2) of
false ->
- error_logger:warning_msg("** Undefined handle_info in ~p~n"
- "** Unhandled message: ~tp~n",
- [Mod, Msg]),
+ ?LOG_WARNING(
+ #{label=>{gen_server,no_handle_info},
+ module=>Mod,
+ message=>Msg},
+ #{domain=>[otp],
+ report_cb=>fun gen_server:format_log/1,
+ error_logger=>#{tag=>warning_msg}}),
{ok, {noreply, State}};
true ->
- {'EXIT', error, R, erlang:get_stacktrace()}
+ {'EXIT', error, R, Stacktrace}
end;
- Class:R ->
- {'EXIT', Class, R, erlang:get_stacktrace()}
+ Class:R:Stacktrace ->
+ {'EXIT', Class, R, Stacktrace}
end.
try_handle_call(Mod, Msg, From, State) ->
@@ -637,8 +662,8 @@ try_handle_call(Mod, Msg, From, State) ->
catch
throw:R ->
{ok, R};
- Class:R ->
- {'EXIT', Class, R, erlang:get_stacktrace()}
+ Class:R:Stacktrace ->
+ {'EXIT', Class, R, Stacktrace}
end.
try_terminate(Mod, Reason, State) ->
@@ -649,8 +674,8 @@ try_terminate(Mod, Reason, State) ->
catch
throw:R ->
{ok, R};
- Class:R ->
- {'EXIT', Class, R, erlang:get_stacktrace()}
+ Class:R:Stacktrace ->
+ {'EXIT', Class, R, Stacktrace}
end;
false ->
{ok, ok}
@@ -833,8 +858,7 @@ terminate(Class, Reason, Stacktrace, ReportReason, Name, From, Msg, Mod, State,
Reply = try_terminate(Mod, terminate_reason(Class, Reason, Stacktrace), State),
case Reply of
{'EXIT', C, R, S} ->
- FmtState = format_status(terminate, Mod, get(), State),
- error_info({R, S}, Name, From, Msg, FmtState, Debug),
+ error_info({R, S}, Name, From, Msg, Mod, State, Debug),
erlang:raise(C, R, S);
_ ->
case {Class, Reason} of
@@ -842,8 +866,7 @@ terminate(Class, Reason, Stacktrace, ReportReason, Name, From, Msg, Mod, State,
{exit, shutdown} -> ok;
{exit, {shutdown,_}} -> ok;
_ ->
- FmtState = format_status(terminate, Mod, get(), State),
- error_info(ReportReason, Name, From, Msg, FmtState, Debug)
+ error_info(ReportReason, Name, From, Msg, Mod, State, Debug)
end
end,
case Stacktrace of
@@ -856,12 +879,46 @@ terminate(Class, Reason, Stacktrace, ReportReason, Name, From, Msg, Mod, State,
terminate_reason(error, Reason, Stacktrace) -> {Reason, Stacktrace};
terminate_reason(exit, Reason, _Stacktrace) -> Reason.
-error_info(_Reason, application_controller, _From, _Msg, _State, _Debug) ->
+error_info(_Reason, application_controller, _From, _Msg, _Mod, _State, _Debug) ->
%% OTP-5811 Don't send an error report if it's the system process
%% application_controller which is terminating - let init take care
%% of it instead
ok;
-error_info(Reason, Name, From, Msg, State, Debug) ->
+error_info(Reason, Name, From, Msg, Mod, State, Debug) ->
+ ?LOG_ERROR(#{label=>{gen_server,terminate},
+ name=>Name,
+ last_message=>Msg,
+ state=>format_status(terminate, Mod, get(), State),
+ reason=>Reason,
+ client_info=>client_stacktrace(From)},
+ #{domain=>[otp],
+ report_cb=>fun gen_server:format_log/1,
+ error_logger=>#{tag=>error}}),
+ sys:print_log(Debug),
+ ok.
+
+client_stacktrace(undefined) ->
+ undefined;
+client_stacktrace({From,_Tag}) ->
+ client_stacktrace(From);
+client_stacktrace(From) when is_pid(From), node(From) =:= node() ->
+ case process_info(From, [current_stacktrace, registered_name]) of
+ undefined ->
+ {From,dead};
+ [{current_stacktrace, Stacktrace}, {registered_name, []}] ->
+ {From,{From,Stacktrace}};
+ [{current_stacktrace, Stacktrace}, {registered_name, Name}] ->
+ {From,{Name,Stacktrace}}
+ end;
+client_stacktrace(From) when is_pid(From) ->
+ {From,remote}.
+
+format_log(#{label:={gen_server,terminate},
+ name:=Name,
+ last_message:=Msg,
+ state:=State,
+ reason:=Reason,
+ client_info:=Client}) ->
Reason1 =
case Reason of
{undef,[{M,F,A,L}|MFAs]} ->
@@ -879,34 +936,29 @@ error_info(Reason, Name, From, Msg, State, Debug) ->
_ ->
error_logger:limit_term(Reason)
end,
- {ClientFmt, ClientArgs} = client_stacktrace(From),
- LimitedState = error_logger:limit_term(State),
- error_logger:format("** Generic server ~tp terminating \n"
- "** Last message in was ~tp~n"
- "** When Server state == ~tp~n"
- "** Reason for termination == ~n** ~tp~n" ++ ClientFmt,
- [Name, Msg, LimitedState, Reason1] ++ ClientArgs),
- sys:print_log(Debug),
- ok.
-client_stacktrace(undefined) ->
+ {ClientFmt,ClientArgs} = format_client_log(Client),
+ {"** Generic server ~tp terminating \n"
+ "** Last message in was ~tp~n"
+ "** When Server state == ~tp~n"
+ "** Reason for termination == ~n** ~tp~n" ++ ClientFmt,
+ [Name, Msg, error_logger:limit_term(State), Reason1] ++ ClientArgs};
+format_log(#{label:={gen_server,no_handle_info},
+ module:=Mod,
+ message:=Msg}) ->
+ {"** Undefined handle_info in ~p~n"
+ "** Unhandled message: ~tp~n",
+ [Mod, Msg]}.
+
+format_client_log(undefined) ->
{"", []};
-client_stacktrace({From, _Tag}) ->
- client_stacktrace(From);
-client_stacktrace(From) when is_pid(From), node(From) =:= node() ->
- case process_info(From, [current_stacktrace, registered_name]) of
- undefined ->
- {"** Client ~p is dead~n", [From]};
- [{current_stacktrace, Stacktrace}, {registered_name, []}] ->
- {"** Client ~p stacktrace~n"
- "** ~tp~n",
- [From, Stacktrace]};
- [{current_stacktrace, Stacktrace}, {registered_name, Name}] ->
- {"** Client ~tp stacktrace~n"
- "** ~tp~n",
- [Name, Stacktrace]}
- end;
-client_stacktrace(From) when is_pid(From) ->
- {"** Client ~p is remote on node ~p~n", [From, node(From)]}.
+format_client_log({From,dead}) ->
+ {"** Client ~p is dead~n", [From]};
+format_client_log({From,remote}) ->
+ {"** Client ~p is remote on node ~p~n", [From, node(From)]};
+format_client_log({_From,{Name,Stacktrace}}) ->
+ {"** Client ~tp stacktrace~n"
+ "** ~tp~n",
+ [Name, Stacktrace]}.
%%-----------------------------------------------------------------
%% Status information
diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl
index eb0d6bd742..faa43fbc1e 100644
--- a/lib/stdlib/src/gen_statem.erl
+++ b/lib/stdlib/src/gen_statem.erl
@@ -19,6 +19,8 @@
%%
-module(gen_statem).
+-include("logger.hrl").
+
%% API
-export(
[start/3,start/4,start_link/3,start_link/4,
@@ -44,6 +46,9 @@
-export(
[wakeup_from_hibernate/3]).
+%% logger callback
+-export([format_log/1]).
+
%% Type exports for templates and callback modules
-export_type(
[event_type/0,
@@ -143,7 +148,7 @@
timeout_action() |
reply_action().
-type timeout_action() ::
- (Timeout :: event_timeout()) | % {timeout,Timeout}
+ (Time :: event_timeout()) | % {timeout,Time,Time}
{'timeout', % Set the event_timeout option
Time :: event_timeout(), EventContent :: term()} |
{'timeout', % Set the event_timeout option
@@ -298,7 +303,7 @@
(Reason :: term()).
%% Format the callback module state in some sensible that is
-%% often condensed way. For StatusOption =:= 'normal' the perferred
+%% often condensed way. For StatusOption =:= 'normal' the preferred
%% return term is [{data,[{"State",FormattedState}]}], and for
%% StatusOption =:= 'terminate' it is just FormattedState.
-callback format_status(
@@ -327,7 +332,8 @@
%% Type validation functions
-compile(
{inline,
- [callback_mode/1, state_enter/1, from/1, event_type/1]}).
+ [callback_mode/1, state_enter/1,
+ event_type/1, from/1, timeout_event_type/1]}).
%%
callback_mode(CallbackMode) ->
case CallbackMode of
@@ -344,28 +350,31 @@ state_enter(StateEnter) ->
false
end.
%%
-from({Pid,_}) when is_pid(Pid) -> true;
-from(_) -> false.
-%%
-event_type({call,From}) ->
- from(From);
event_type(Type) ->
case Type of
{call,From} -> from(From);
+ %%
cast -> true;
info -> true;
- timeout -> true;
- state_timeout -> true;
internal -> true;
- {timeout,_} -> true;
- _ -> false
+ _ -> timeout_event_type(Type)
+ end.
+%%
+from({Pid,_}) when is_pid(Pid) -> true;
+from(_) -> false.
+%%
+timeout_event_type(Type) ->
+ case Type of
+ timeout -> true;
+ state_timeout -> true;
+ {timeout,_Name} -> true;
+ _ -> false
end.
-
-define(
STACKTRACE(),
- try throw(ok) catch _ -> erlang:get_stacktrace() end).
+ element(2, erlang:process_info(self(), current_stacktrace))).
-define(not_sys_debug, []).
%%
@@ -517,8 +526,6 @@ call(ServerRef, Request, infinity = T = Timeout) ->
call_dirty(ServerRef, Request, Timeout, T);
call(ServerRef, Request, {dirty_timeout, T} = Timeout) ->
call_dirty(ServerRef, Request, Timeout, T);
-call(ServerRef, Request, {clean_timeout, infinity = T} = Timeout) ->
- call_dirty(ServerRef, Request, Timeout, T);
call(ServerRef, Request, {clean_timeout, T} = Timeout) ->
call_clean(ServerRef, Request, Timeout, T);
call(ServerRef, Request, {_, _} = Timeout) ->
@@ -592,11 +599,11 @@ call_dirty(ServerRef, Request, Timeout, T) ->
{ok,Reply} ->
Reply
catch
- Class:Reason ->
+ Class:Reason:Stacktrace ->
erlang:raise(
Class,
{Reason,{?MODULE,call,[ServerRef,Request,Timeout]}},
- erlang:get_stacktrace())
+ Stacktrace)
end.
call_clean(ServerRef, Request, Timeout, T) ->
@@ -610,9 +617,8 @@ call_clean(ServerRef, Request, Timeout, T) ->
ServerRef, '$gen_call', Request, T) of
Result ->
{Ref,Result}
- catch Class:Reason ->
- {Ref,Class,Reason,
- erlang:get_stacktrace()}
+ catch Class:Reason:Stacktrace ->
+ {Ref,Class,Reason,Stacktrace}
end
end),
Mref = monitor(process, Pid),
@@ -644,16 +650,11 @@ replies([]) ->
%% Might actually not send the message in case of caught exception
send(Proc, Msg) ->
- try erlang:send(Proc, Msg, [noconnect]) of
- noconnect ->
- _ = spawn(erlang, send, [Proc,Msg]),
- ok;
- ok ->
- ok
+ try erlang:send(Proc, Msg)
catch
- _:_ ->
- ok
- end.
+ error:_ -> ok
+ end,
+ ok.
%% Here the init_it/6 and enter_loop/5,6,7 functions converge
enter(Module, Opts, State, Data, Server, Actions, Parent) ->
@@ -699,15 +700,14 @@ init_it(Starter, Parent, ServerRef, Module, Args, Opts) ->
catch
Result ->
init_result(Starter, Parent, ServerRef, Module, Result, Opts);
- Class:Reason ->
- Stacktrace = erlang:get_stacktrace(),
+ Class:Reason:Stacktrace ->
Name = gen:get_proc_name(ServerRef),
gen:unregister_name(ServerRef),
proc_lib:init_ack(Starter, {error,Reason}),
error_info(
Class, Reason, Stacktrace,
#state{name = Name},
- [], undefined),
+ []),
erlang:raise(Class, Reason, Stacktrace)
end.
@@ -738,7 +738,7 @@ init_result(Starter, Parent, ServerRef, Module, Result, Opts) ->
error_info(
error, Error, ?STACKTRACE(),
#state{name = Name},
- [], undefined),
+ []),
exit(Error)
end.
@@ -1065,6 +1065,15 @@ loop_event_result(
Parent, Debug, S,
Events, Event, NextState, NewData, TransOpts,
[], true);
+ {next_state,_NextState,_NewData} ->
+ terminate(
+ error,
+ {bad_state_enter_return_from_state_function,Result},
+ ?STACKTRACE(), Debug,
+ S#state{
+ state = State, data = Data,
+ hibernate = hibernate_in_trans_opts(TransOpts)},
+ [Event|Events]);
{next_state,State,NewData,Actions} ->
loop_event_actions(
Parent, Debug, S,
@@ -1076,6 +1085,15 @@ loop_event_result(
Parent, Debug, S,
Events, Event, NextState, NewData, TransOpts,
Actions, true);
+ {next_state,_NextState,_NewData,_Actions} ->
+ terminate(
+ error,
+ {bad_state_enter_return_from_state_function,Result},
+ ?STACKTRACE(), Debug,
+ S#state{
+ state = State, data = Data,
+ hibernate = hibernate_in_trans_opts(TransOpts)},
+ [Event|Events]);
%%
{keep_state,NewData} ->
loop_event_actions(
@@ -1169,12 +1187,6 @@ loop_event_result(
[Event|Events])
end.
--compile({inline, [hibernate_in_trans_opts/1]}).
-hibernate_in_trans_opts(false) ->
- (#trans_opts{})#trans_opts.hibernate;
-hibernate_in_trans_opts(#trans_opts{hibernate = Hibernate}) ->
- Hibernate.
-
%% Ensure that Actions are a list
loop_event_actions(
Parent, Debug, S,
@@ -1207,10 +1219,16 @@ loop_event_actions_list(
S#state{
state = NextState,
data = NewerData,
- hibernate = TransOpts#trans_opts.hibernate},
+ hibernate = hibernate_in_trans_opts(TransOpts)},
[Event|Events])
end.
+-compile({inline, [hibernate_in_trans_opts/1]}).
+hibernate_in_trans_opts(false) ->
+ (#trans_opts{})#trans_opts.hibernate;
+hibernate_in_trans_opts(#trans_opts{hibernate = Hibernate}) ->
+ Hibernate.
+
parse_actions(false, Debug, S, Actions) ->
parse_actions(true, Debug, S, Actions, #trans_opts{});
parse_actions(TransOpts, Debug, S, Actions) ->
@@ -1243,6 +1261,11 @@ parse_actions(StateCall, Debug, S, [Action|Actions], TransOpts) ->
parse_actions(
StateCall, Debug, S, Actions,
TransOpts#trans_opts{postpone = true});
+ postpone ->
+ [error,
+ {bad_state_enter_action_from_state_function,Action},
+ ?STACKTRACE(),
+ Debug];
%%
{next_event,Type,Content} ->
parse_actions_next_event(
@@ -1295,7 +1318,8 @@ parse_actions_next_event(
next_events_r = [{Type,Content}|NextEventsR]});
_ ->
[error,
- {bad_action_from_state_function,{next_event,Type,Content}},
+ {bad_state_enter_action_from_state_function,
+ {next_event,Type,Content}},
?STACKTRACE(),
?not_sys_debug]
end;
@@ -1312,22 +1336,23 @@ parse_actions_next_event(
next_events_r = [{Type,Content}|NextEventsR]});
_ ->
[error,
- {bad_action_from_state_function,{next_event,Type,Content}},
+ {bad_state_enter_action_from_state_function,
+ {next_event,Type,Content}},
?STACKTRACE(),
Debug]
end.
parse_actions_timeout(
StateCall, Debug, S, Actions, TransOpts,
- {TimerType,Time,TimerMsg,TimerOpts} = AbsoluteTimeout) ->
+ {TimeoutType,Time,TimerMsg,TimerOpts} = AbsoluteTimeout) ->
%%
- case classify_timer(Time, listify(TimerOpts)) of
+ case classify_timeout(TimeoutType, Time, listify(TimerOpts)) of
absolute ->
parse_actions_timeout_add(
StateCall, Debug, S, Actions,
TransOpts, AbsoluteTimeout);
relative ->
- RelativeTimeout = {TimerType,Time,TimerMsg},
+ RelativeTimeout = {TimeoutType,Time,TimerMsg},
parse_actions_timeout_add(
StateCall, Debug, S, Actions,
TransOpts, RelativeTimeout);
@@ -1339,8 +1364,8 @@ parse_actions_timeout(
end;
parse_actions_timeout(
StateCall, Debug, S, Actions, TransOpts,
- {_,Time,_} = RelativeTimeout) ->
- case classify_timer(Time, []) of
+ {TimeoutType,Time,_} = RelativeTimeout) ->
+ case classify_timeout(TimeoutType, Time, []) of
relative ->
parse_actions_timeout_add(
StateCall, Debug, S, Actions,
@@ -1353,14 +1378,16 @@ parse_actions_timeout(
end;
parse_actions_timeout(
StateCall, Debug, S, Actions, TransOpts,
- Timeout) ->
- case classify_timer(Timeout, []) of
+ Time) ->
+ case classify_timeout(timeout, Time, []) of
relative ->
+ RelativeTimeout = {timeout,Time,Time},
parse_actions_timeout_add(
- StateCall, Debug, S, Actions, TransOpts, Timeout);
+ StateCall, Debug, S, Actions,
+ TransOpts, RelativeTimeout);
badarg ->
[error,
- {bad_action_from_state_function,Timeout},
+ {bad_action_from_state_function,Time},
?STACKTRACE(),
Debug]
end.
@@ -1421,13 +1448,13 @@ loop_event_done(
[?sys_debug(
Debug_0,
{S#state.name,State},
- {postpone,Event_0,State}),
+ {postpone,Event_0,NextState}),
Event_0|P_0];
false ->
[?sys_debug(
Debug_0,
{S#state.name,State},
- {consume,Event_0,State})|P_0]
+ {consume,Event_0,NextState})|P_0]
end,
{Events_2,P_2,Timers_2} =
%% Move all postponed events to queue,
@@ -1586,8 +1613,8 @@ call_callback_mode(#state{module = Module} = S) ->
catch
CallbackMode ->
callback_mode_result(S, CallbackMode);
- Class:Reason ->
- [Class,Reason,erlang:get_stacktrace()]
+ Class:Reason:Stacktrace ->
+ [Class,Reason,Stacktrace]
end.
callback_mode_result(S, CallbackMode) ->
@@ -1640,16 +1667,21 @@ call_state_function(
catch
Result ->
{Result,S};
- Class:Reason ->
- [Class,Reason,erlang:get_stacktrace()]
+ Class:Reason:Stacktrace ->
+ [Class,Reason,Stacktrace]
end.
%% -> absolute | relative | badarg
-classify_timer(Time, Opts) ->
- classify_timer(Time, Opts, false).
-%%
-classify_timer(Time, [], Abs) ->
+classify_timeout(TimeoutType, Time, Opts) ->
+ case timeout_event_type(TimeoutType) of
+ true ->
+ classify_time(false, Time, Opts);
+ false ->
+ badarg
+ end.
+
+classify_time(Abs, Time, []) ->
case Abs of
true when
is_integer(Time);
@@ -1662,9 +1694,9 @@ classify_timer(Time, [], Abs) ->
_ ->
badarg
end;
-classify_timer(Time, [{abs,Abs}|Opts], _) when is_boolean(Abs) ->
- classify_timer(Time, Opts, Abs);
-classify_timer(_, Opts, _) when is_list(Opts) ->
+classify_time(_, Time, [{abs,Abs}|Opts]) when is_boolean(Abs) ->
+ classify_time(Abs, Time, Opts);
+classify_time(_, _, Opts) when is_list(Opts) ->
badarg.
%% Stop and start timers as well as create timeout zero events
@@ -1695,15 +1727,7 @@ parse_timers(
{TimerType,Time,TimerMsg} ->
parse_timers(
TimerRefs, Timers, TimeoutsR, Seen, TimeoutEvents,
- TimerType, Time, TimerMsg, []);
- 0 ->
- parse_timers(
- TimerRefs, Timers, TimeoutsR, Seen, TimeoutEvents,
- timeout, zero, 0, []);
- Time ->
- parse_timers(
- TimerRefs, Timers, TimeoutsR, Seen, TimeoutEvents,
- timeout, Time, Time, [])
+ TimerType, Time, TimerMsg, [])
end.
parse_timers(
@@ -1829,11 +1853,8 @@ terminate(
_ -> ok
catch
_ -> ok;
- C:R ->
- ST = erlang:get_stacktrace(),
- error_info(
- C, R, ST, S, Q,
- format_status(terminate, get(), S)),
+ C:R:ST ->
+ error_info(C, R, ST, S, Q),
sys:print_log(Debug),
erlang:raise(C, R, ST)
end;
@@ -1849,9 +1870,7 @@ terminate(
{shutdown,_} ->
terminate_sys_debug(Debug, S, State, Reason);
_ ->
- error_info(
- Class, Reason, Stacktrace, S, Q,
- format_status(terminate, get(), S)),
+ error_info(Class, Reason, Stacktrace, S, Q),
sys:print_log(Debug)
end,
case Stacktrace of
@@ -1871,8 +1890,28 @@ error_info(
name = Name,
callback_mode = CallbackMode,
state_enter = StateEnter,
- postponed = P},
- Q, FmtData) ->
+ postponed = P} = S,
+ Q) ->
+ ?LOG_ERROR(#{label=>{gen_statem,terminate},
+ name=>Name,
+ queue=>Q,
+ postponed=>P,
+ callback_mode=>CallbackMode,
+ state_enter=>StateEnter,
+ state=>format_status(terminate, get(), S),
+ reason=>{Class,Reason,Stacktrace}},
+ #{domain=>[otp],
+ report_cb=>fun gen_statem:format_log/1,
+ error_logger=>#{tag=>error}}).
+
+format_log(#{label:={gen_statem,terminate},
+ name:=Name,
+ queue:=Q,
+ postponed:=P,
+ callback_mode:=CallbackMode,
+ state_enter:=StateEnter,
+ state:=FmtData,
+ reason:={Class,Reason,Stacktrace}}) ->
{FixedReason,FixedStacktrace} =
case Stacktrace of
[{M,F,Args,_}|ST]
@@ -1907,48 +1946,46 @@ error_info(
false ->
CallbackMode
end,
- error_logger:format(
- "** State machine ~tp terminating~n" ++
- case Q of
- [] -> "";
- _ -> "** Last event = ~tp~n"
- end ++
- "** When server state = ~tp~n" ++
- "** Reason for termination = ~w:~tp~n" ++
- "** Callback mode = ~p~n" ++
- case Q of
- [_,_|_] -> "** Queued = ~tp~n";
- _ -> ""
- end ++
- case P of
- [] -> "";
- _ -> "** Postponed = ~tp~n"
- end ++
- case FixedStacktrace of
- [] -> "";
- _ -> "** Stacktrace =~n** ~tp~n"
- end,
- [Name |
- case Q of
- [] -> [];
- [Event|_] -> [Event]
- end] ++
- [LimitedFmtData,
- Class,LimitedFixedReason,
- CBMode] ++
- case Q of
- [_|[_|_] = Events] -> [Events];
- _ -> []
- end ++
- case P of
- [] -> [];
- _ -> [LimitedP]
- end ++
- case FixedStacktrace of
- [] -> [];
- _ -> [FixedStacktrace]
- end).
-
+ {"** State machine ~tp terminating~n" ++
+ case Q of
+ [] -> "";
+ _ -> "** Last event = ~tp~n"
+ end ++
+ "** When server state = ~tp~n" ++
+ "** Reason for termination = ~w:~tp~n" ++
+ "** Callback mode = ~p~n" ++
+ case Q of
+ [_,_|_] -> "** Queued = ~tp~n";
+ _ -> ""
+ end ++
+ case P of
+ [] -> "";
+ _ -> "** Postponed = ~tp~n"
+ end ++
+ case FixedStacktrace of
+ [] -> "";
+ _ -> "** Stacktrace =~n** ~tp~n"
+ end,
+ [Name |
+ case Q of
+ [] -> [];
+ [Event|_] -> [Event]
+ end] ++
+ [LimitedFmtData,
+ Class,LimitedFixedReason,
+ CBMode] ++
+ case Q of
+ [_|[_|_] = Events] -> [Events];
+ _ -> []
+ end ++
+ case P of
+ [] -> [];
+ _ -> [LimitedP]
+ end ++
+ case FixedStacktrace of
+ [] -> [];
+ _ -> [FixedStacktrace]
+ end}.
%% Call Module:format_status/2 or return a default value
format_status(
diff --git a/lib/stdlib/src/io.erl b/lib/stdlib/src/io.erl
index f510f61e9f..63c9a6bddf 100644
--- a/lib/stdlib/src/io.erl
+++ b/lib/stdlib/src/io.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2015. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -86,7 +86,16 @@ put_chars(Chars) ->
CharData :: unicode:chardata().
put_chars(Io, Chars) ->
- o_request(Io, {put_chars,unicode,Chars}, put_chars).
+ put_chars(Io, unicode, Chars).
+
+%% This function is here to make the erlang:raise in o_request actually raise to
+%% a valid function.
+-spec put_chars(IoDevice, Encoding, CharData) -> 'ok' when
+ IoDevice :: device(),
+ Encoding :: unicode,
+ CharData :: unicode:chardata().
+put_chars(Io, Encoding, Chars) ->
+ o_request(Io, {put_chars,Encoding,Chars}, put_chars).
-spec nl() -> 'ok'.
diff --git a/lib/stdlib/src/io_lib.erl b/lib/stdlib/src/io_lib.erl
index 50bf959db5..8223a52873 100644
--- a/lib/stdlib/src/io_lib.erl
+++ b/lib/stdlib/src/io_lib.erl
@@ -60,11 +60,12 @@
-module(io_lib).
--export([fwrite/2,fread/2,fread/3,format/2]).
--export([scan_format/2,unscan_format/1,build_text/1]).
+-export([fwrite/2,fwrite/3,fread/2,fread/3,format/2,format/3]).
+-export([scan_format/2,unscan_format/1,build_text/1,build_text/2]).
-export([print/1,print/4,indentation/2]).
-export([write/1,write/2,write/3,nl/0,format_prompt/1,format_prompt/2]).
+-export([write_binary/3]).
-export([write_atom/1,write_string/1,write_string/2,write_latin1_string/1,
write_latin1_string/2, write_char/1, write_latin1_char/1]).
@@ -87,7 +88,7 @@
-export([limit_term/2]).
-export_type([chars/0, latin1_string/0, continuation/0,
- fread_error/0, fread_item/0, format_spec/0]).
+ fread_error/0, fread_item/0, format_spec/0, chars_limit/0]).
%%----------------------------------------------------------------------
@@ -135,6 +136,18 @@
fwrite(Format, Args) ->
format(Format, Args).
+-type chars_limit() :: integer().
+
+-spec fwrite(Format, Data, Options) -> chars() when
+ Format :: io:format(),
+ Data :: [term()],
+ Options :: [Option],
+ Option :: {'chars_limit', CharsLimit},
+ CharsLimit :: chars_limit().
+
+fwrite(Format, Args, Options) ->
+ format(Format, Args, Options).
+
-spec fread(Format, String) -> Result when
Format :: string(),
String :: string(),
@@ -165,11 +178,26 @@ fread(Cont, Chars, Format) ->
Data :: [term()].
format(Format, Args) ->
- case catch io_lib_format:fwrite(Format, Args) of
- {'EXIT',_} ->
- erlang:error(badarg, [Format, Args]);
- Other ->
- Other
+ try io_lib_format:fwrite(Format, Args)
+ catch
+ C:R:S ->
+ test_modules_loaded(C, R, S),
+ erlang:error(badarg, [Format, Args])
+ end.
+
+-spec format(Format, Data, Options) -> chars() when
+ Format :: io:format(),
+ Data :: [term()],
+ Options :: [Option],
+ Option :: {'chars_limit', CharsLimit},
+ CharsLimit :: chars_limit().
+
+format(Format, Args, Options) ->
+ try io_lib_format:fwrite(Format, Args, Options)
+ catch
+ C:R:S ->
+ test_modules_loaded(C, R, S),
+ erlang:error(badarg, [Format, Args])
end.
-spec scan_format(Format, Data) -> FormatList when
@@ -180,7 +208,9 @@ format(Format, Args) ->
scan_format(Format, Args) ->
try io_lib_format:scan(Format, Args)
catch
- _:_ -> erlang:error(badarg, [Format, Args])
+ C:R:S ->
+ test_modules_loaded(C, R, S),
+ erlang:error(badarg, [Format, Args])
end.
-spec unscan_format(FormatList) -> {Format, Data} when
@@ -195,7 +225,37 @@ unscan_format(FormatList) ->
FormatList :: [char() | format_spec()].
build_text(FormatList) ->
- io_lib_format:build(FormatList).
+ try io_lib_format:build(FormatList)
+ catch
+ C:R:S ->
+ test_modules_loaded(C, R, S),
+ erlang:error(badarg, [FormatList])
+ end.
+
+-spec build_text(FormatList, Options) -> chars() when
+ FormatList :: [char() | format_spec()],
+ Options :: [Option],
+ Option :: {'chars_limit', CharsLimit},
+ CharsLimit :: chars_limit().
+
+build_text(FormatList, Options) ->
+ try io_lib_format:build(FormatList, Options)
+ catch
+ C:R:S ->
+ test_modules_loaded(C, R, S),
+ erlang:error(badarg, [FormatList, Options])
+ end.
+
+%% Failure to load a module must not be labeled as badarg.
+%% C, R, and S are included so that the original error, which could be
+%% a bug in io_lib_format, can be found by tracing on
+%% test_modules_loaded/3.
+test_modules_loaded(_C, _R, _S) ->
+ Modules = [io_lib_format, io_lib_pretty, string, unicode],
+ case code:ensure_modules_loaded(Modules) of
+ ok -> ok;
+ Error -> erlang:error(Error)
+ end.
-spec print(Term) -> chars() when
Term :: term().
@@ -240,7 +300,7 @@ format_prompt(Prompt, Encoding) ->
do_format_prompt(add_modifier(Encoding, "p"), [Prompt]).
do_format_prompt(Format, Args) ->
- case catch io_lib:format(Format, Args) of
+ case catch format(Format, Args) of
{'EXIT',_} -> "???";
List -> List
end.
@@ -259,7 +319,8 @@ add_modifier(_, C) ->
-spec write(Term) -> chars() when
Term :: term().
-write(Term) -> write(Term, -1).
+write(Term) ->
+ write1(Term, -1, latin1).
-spec write(term(), depth(), boolean()) -> chars().
@@ -274,16 +335,29 @@ write(Term, D, false) ->
(Term, Options) -> chars() when
Term :: term(),
Options :: [Option],
- Option :: {'depth', Depth}
+ Option :: {'chars_limit', CharsLimit}
+ | {'depth', Depth}
| {'encoding', 'latin1' | 'utf8' | 'unicode'},
+ CharsLimit :: chars_limit(),
Depth :: depth().
write(Term, Options) when is_list(Options) ->
Depth = get_option(depth, Options, -1),
Encoding = get_option(encoding, Options, epp:default_encoding()),
- write1(Term, Depth, Encoding);
+ CharsLimit = get_option(chars_limit, Options, -1),
+ if
+ Depth =:= 0; CharsLimit =:= 0 ->
+ "...";
+ CharsLimit < 0 ->
+ write1(Term, Depth, Encoding);
+ CharsLimit > 0 ->
+ RecDefFun = fun(_, _) -> no end,
+ If = io_lib_pretty:intermediate
+ (Term, Depth, CharsLimit, RecDefFun, Encoding, _Str=false),
+ io_lib_pretty:write(If)
+ end;
write(Term, Depth) ->
- write1(Term, Depth, latin1).
+ write(Term, [{depth, Depth}, {encoding, latin1}]).
write1(_Term, 0, _E) -> "...";
write1(Term, _D, _E) when is_integer(Term) -> integer_to_list(Term);
@@ -300,7 +374,7 @@ write1([H|T], D, E) ->
if
D =:= 1 -> "[...]";
true ->
- [$[,[write1(H, D-1, E)|write_tail(T, D-1, E, $|)],$]]
+ [$[,[write1(H, D-1, E)|write_tail(T, D-1, E)],$]]
end;
write1(F, _D, _E) when is_function(F) ->
erlang:fun_to_list(F);
@@ -311,20 +385,24 @@ write1(T, D, E) when is_tuple(T) ->
D =:= 1 -> "{...}";
true ->
[${,
- [write1(element(1, T), D-1, E)|
- write_tail(tl(tuple_to_list(T)), D-1, E, $,)],
+ [write1(element(1, T), D-1, E)|write_tuple(T, 2, D-1, E)],
$}]
end.
-%% write_tail(List, Depth, CharacterBeforeDots)
+%% write_tail(List, Depth, Encoding)
%% Test the terminating case first as this looks better with depth.
-write_tail([], _D, _E, _S) -> "";
-write_tail(_, 1, _E, S) -> [S | "..."];
-write_tail([H|T], D, E, S) ->
- [$,,write1(H, D-1, E)|write_tail(T, D-1, E, S)];
-write_tail(Other, D, E, S) ->
- [S,write1(Other, D-1, E)].
+write_tail([], _D, _E) -> "";
+write_tail(_, 1, _E) -> [$| | "..."];
+write_tail([H|T], D, E) ->
+ [$,,write1(H, D-1, E)|write_tail(T, D-1, E)];
+write_tail(Other, D, E) ->
+ [$|,write1(Other, D-1, E)].
+
+write_tuple(T, I, _D, _E) when I > tuple_size(T) -> "";
+write_tuple(_, _I, 1, _E) -> [$, | "..."];
+write_tuple(T, I, D, E) ->
+ [$,,write1(element(I, T), D-1, E)|write_tuple(T, I+1, D-1, E)].
write_port(Port) ->
erlang:port_to_list(Port).
@@ -333,32 +411,43 @@ write_ref(Ref) ->
erlang:ref_to_list(Ref).
write_map(Map, D, E) when is_integer(D) ->
- [$#,${,write_map_body(maps:to_list(Map), D, E),$}].
+ [$#,${,write_map_body(maps:to_list(Map), D, D - 1, E),$}].
-write_map_body(_, 0, _E) -> "...";
-write_map_body([], _, _E) -> [];
-write_map_body([{K,V}], D, E) -> write_map_assoc(K, V, D, E);
-write_map_body([{K,V}|KVs], D, E) ->
- [write_map_assoc(K, V, D, E),$, | write_map_body(KVs, D-1, E)].
+write_map_body(_, 1, _D0, _E) -> "...";
+write_map_body([], _, _D0, _E) -> [];
+write_map_body([{K,V}], _D, D0, E) -> write_map_assoc(K, V, D0, E);
+write_map_body([{K,V}|KVs], D, D0, E) ->
+ [write_map_assoc(K, V, D0, E),$, | write_map_body(KVs, D - 1, D0, E)].
write_map_assoc(K, V, D, E) ->
- [write1(K, D - 1, E),"=>",write1(V, D-1, E)].
+ [write1(K, D, E)," => ",write1(V, D, E)].
write_binary(B, D) when is_integer(D) ->
- [$<,$<,write_binary_body(B, D),$>,$>].
-
-write_binary_body(<<>>, _D) ->
- "";
-write_binary_body(_B, 1) ->
- "...";
-write_binary_body(<<X:8>>, _D) ->
- [integer_to_list(X)];
-write_binary_body(<<X:8,Rest/bitstring>>, D) ->
- [integer_to_list(X),$,|write_binary_body(Rest, D-1)];
-write_binary_body(B, _D) ->
+ {S, _} = write_binary(B, D, -1),
+ S.
+
+write_binary(B, D, T) ->
+ {S, Rest} = write_binary_body(B, D, tsub(T, 4), []),
+ {[$<,$<,lists:reverse(S),$>,$>], Rest}.
+
+write_binary_body(<<>> = B, _D, _T, Acc) ->
+ {Acc, B};
+write_binary_body(B, D, T, Acc) when D =:= 1; T =:= 0->
+ {["..."|Acc], B};
+write_binary_body(<<X:8>>, _D, _T, Acc) ->
+ {[integer_to_list(X)|Acc], <<>>};
+write_binary_body(<<X:8,Rest/bitstring>>, D, T, Acc) ->
+ S = integer_to_list(X),
+ write_binary_body(Rest, D-1, tsub(T, length(S) + 1), [$,,S|Acc]);
+write_binary_body(B, _D, _T, Acc) ->
L = bit_size(B),
<<X:L>> = B,
- [integer_to_list(X),$:,integer_to_list(L)].
+ {[integer_to_list(L),$:,integer_to_list(X)|Acc], <<>>}.
+
+%% Make sure T does not change sign.
+tsub(T, _) when T < 0 -> T;
+tsub(T, E) when T >= E -> T - E;
+tsub(_, _) -> 0.
get_option(Key, TupleList, Default) ->
case lists:keyfind(Key, 1, TupleList) of
@@ -931,7 +1020,7 @@ limit_term(Term, Depth) ->
limit(_, 0) -> '...';
limit([H|T]=L, D) ->
if
- D =:= 1 -> '...';
+ D =:= 1 -> ['...'];
true ->
case printable_list(L) of
true -> L;
@@ -944,10 +1033,10 @@ limit(Term, D) when is_map(Term) ->
limit({}=T, _D) -> T;
limit(T, D) when is_tuple(T) ->
if
- D =:= 1 -> '...';
+ D =:= 1 -> {'...'};
true ->
list_to_tuple([limit(element(1, T), D-1)|
- limit_tail(tl(tuple_to_list(T)), D-1)])
+ limit_tuple(T, 2, D-1)])
end;
limit(<<_/bitstring>>=Term, D) -> limit_bitstring(Term, D);
limit(Term, _D) -> Term.
@@ -959,23 +1048,36 @@ limit_tail([H|T], D) ->
limit_tail(Other, D) ->
limit(Other, D-1).
+limit_tuple(T, I, _D) when I > tuple_size(T) -> [];
+limit_tuple(_, _I, 1) -> ['...'];
+limit_tuple(T, I, D) ->
+ [limit(element(I, T), D-1)|limit_tuple(T, I+1, D-1)].
+
%% Cannot limit maps properly since there is no guarantee that
%% maps:from_list() creates a map with the same internal ordering of
-%% the selected associations as in Map.
+%% the selected associations as in Map. Instead of subtracting one
+%% from the depth as the map associations are traversed (as is done
+%% for tuples and lists), the same depth is applied to each and every
+%% (returned) association.
limit_map(Map, D) ->
- maps:from_list(erts_internal:maps_to_list(Map, D)).
-%% maps:from_list(limit_map_body(erts_internal:maps_to_list(Map, D), D)).
-
-%% limit_map_body(_, 0) -> [{'...', '...'}];
-%% limit_map_body([], _) -> [];
-%% limit_map_body([{K,V}], D) -> [limit_map_assoc(K, V, D)];
-%% limit_map_body([{K,V}|KVs], D) ->
-%% [limit_map_assoc(K, V, D) | limit_map_body(KVs, D-1)].
+ %% Keep one extra association to make sure the final ',...' is included.
+ limit_map_body(maps:iterator(Map), D + 1, D, []).
+
+limit_map_body(_I, 0, _D0, Acc) ->
+ maps:from_list(Acc);
+limit_map_body(I, D, D0, Acc) ->
+ case maps:next(I) of
+ {K, V, NextI} ->
+ limit_map_body(NextI, D-1, D0, [limit_map_assoc(K, V, D0) | Acc]);
+ none ->
+ maps:from_list(Acc)
+ end.
-%% limit_map_assoc(K, V, D) ->
-%% {limit(K, D-1), limit(V, D-1)}.
+limit_map_assoc(K, V, D) ->
+ %% Keep keys as are to avoid creating duplicated keys.
+ {K, limit(V, D - 1)}.
-limit_bitstring(B, _D) -> B. %% Keeps all printable binaries.
+limit_bitstring(B, _D) -> B. % Keeps all printable binaries.
test_limit(_, 0) -> throw(limit);
test_limit([H|T]=L, D) when is_integer(D) ->
@@ -1011,18 +1113,21 @@ test_limit_tuple(T, I, Sz, D) ->
test_limit(element(I, T), D-1),
test_limit_tuple(T, I+1, Sz, D-1).
-test_limit_map(_Map, _D) -> ok.
-%% test_limit_map_body(erts_internal:maps_to_list(Map, D), D).
-
-%% test_limit_map_body(_, 0) -> throw(limit);
-%% test_limit_map_body([], _) -> ok;
-%% test_limit_map_body([{K,V}], D) -> test_limit_map_assoc(K, V, D);
-%% test_limit_map_body([{K,V}|KVs], D) ->
-%% test_limit_map_assoc(K, V, D),
-%% test_limit_map_body(KVs, D-1).
+test_limit_map(Map, D) ->
+ test_limit_map_body(maps:iterator(Map), D).
+
+test_limit_map_body(_I, 0) -> throw(limit); % cannot happen
+test_limit_map_body(I, D) ->
+ case maps:next(I) of
+ {K, V, NextI} ->
+ test_limit_map_assoc(K, V, D),
+ test_limit_map_body(NextI, D-1);
+ none ->
+ ok
+ end.
-%% test_limit_map_assoc(K, V, D) ->
-%% test_limit(K, D-1),
-%% test_limit(V, D-1).
+test_limit_map_assoc(K, V, D) ->
+ test_limit(K, D - 1),
+ test_limit(V, D - 1).
test_limit_bitstring(_, _) -> ok.
diff --git a/lib/stdlib/src/io_lib_format.erl b/lib/stdlib/src/io_lib_format.erl
index 4b2d15c8b3..ab9031573b 100644
--- a/lib/stdlib/src/io_lib_format.erl
+++ b/lib/stdlib/src/io_lib_format.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -21,7 +21,8 @@
%% Formatting functions of io library.
--export([fwrite/2,fwrite_g/1,indentation/2,scan/2,unscan/1,build/1]).
+-export([fwrite/2,fwrite/3,fwrite_g/1,indentation/2,scan/2,unscan/1,
+ build/1, build/2]).
%% Format the arguments in Args after string Format. Just generate
%% an error if there is an error in the arguments.
@@ -37,22 +38,48 @@
%% and it also splits the handling of the control characters into two
%% parts.
--spec fwrite(Format, Data) -> FormatList when
+-spec fwrite(Format, Data) -> io_lib:chars() when
Format :: io:format(),
- Data :: [term()],
- FormatList :: [char() | io_lib:format_spec()].
+ Data :: [term()].
fwrite(Format, Args) ->
build(scan(Format, Args)).
+-spec fwrite(Format, Data, Options) -> io_lib:chars() when
+ Format :: io:format(),
+ Data :: [term()],
+ Options :: [Option],
+ Option :: {'chars_limit', CharsLimit},
+ CharsLimit :: io_lib:chars_limit().
+
+fwrite(Format, Args, Options) ->
+ build(scan(Format, Args), Options).
+
%% Build the output text for a pre-parsed format list.
-spec build(FormatList) -> io_lib:chars() when
FormatList :: [char() | io_lib:format_spec()].
build(Cs) ->
- Pc = pcount(Cs),
- build(Cs, Pc, 0).
+ build(Cs, []).
+
+-spec build(FormatList, Options) -> io_lib:chars() when
+ FormatList :: [char() | io_lib:format_spec()],
+ Options :: [Option],
+ Option :: {'chars_limit', CharsLimit},
+ CharsLimit :: io_lib:chars_limit().
+
+build(Cs, Options) ->
+ CharsLimit = get_option(chars_limit, Options, -1),
+ Res1 = build_small(Cs),
+ {P, S, W, Other} = count_small(Res1),
+ case P + S + W of
+ 0 ->
+ Res1;
+ NumOfLimited ->
+ RemainingChars = sub(CharsLimit, Other),
+ build_limited(Res1, P, NumOfLimited, RemainingChars, 0)
+ end.
%% Parse all control sequences in the format string.
@@ -95,7 +122,7 @@ print([]) ->
[].
print(C, F, Ad, P, Pad, Encoding, Strings) ->
- [$~] ++ print_field_width(F, Ad) ++ print_precision(P) ++
+ [$~] ++ print_field_width(F, Ad) ++ print_precision(P, Pad) ++
print_pad_char(Pad) ++ print_encoding(Encoding) ++
print_strings(Strings) ++ [C].
@@ -103,8 +130,9 @@ print_field_width(none, _Ad) -> "";
print_field_width(F, left) -> integer_to_list(-F);
print_field_width(F, right) -> integer_to_list(F).
-print_precision(none) -> "";
-print_precision(P) -> [$. | integer_to_list(P)].
+print_precision(none, $\s) -> "";
+print_precision(none, _Pad) -> "."; % pad must be second dot
+print_precision(P, _Pad) -> [$. | integer_to_list(P)].
print_pad_char($\s) -> ""; % default, no need to make explicit
print_pad_char(Pad) -> [$., Pad].
@@ -126,25 +154,23 @@ collect_cseq(Fmt0, Args0) ->
{F,Ad,Fmt1,Args1} = field_width(Fmt0, Args0),
{P,Fmt2,Args2} = precision(Fmt1, Args1),
{Pad,Fmt3,Args3} = pad_char(Fmt2, Args2),
- {Encoding,Fmt4,Args4} = encoding(Fmt3, Args3),
- {Strings,Fmt5,Args5} = strings(Fmt4, Args4),
- {C,As,Fmt6,Args6} = collect_cc(Fmt5, Args5),
- FormatSpec = #{control_char => C, args => As, width => F, adjust => Ad,
- precision => P, pad_char => Pad, encoding => Encoding,
- strings => Strings},
- {FormatSpec,Fmt6,Args6}.
-
-encoding([$t|Fmt],Args) ->
- true = hd(Fmt) =/= $l,
- {unicode,Fmt,Args};
-encoding(Fmt,Args) ->
- {latin1,Fmt,Args}.
-
-strings([$l|Fmt],Args) ->
- true = hd(Fmt) =/= $t,
- {false,Fmt,Args};
-strings(Fmt,Args) ->
- {true,Fmt,Args}.
+ Spec0 = #{width => F,
+ adjust => Ad,
+ precision => P,
+ pad_char => Pad,
+ encoding => latin1,
+ strings => true},
+ {Spec1,Fmt4} = modifiers(Fmt3, Spec0),
+ {C,As,Fmt5,Args4} = collect_cc(Fmt4, Args3),
+ Spec2 = Spec1#{control_char => C, args => As},
+ {Spec2,Fmt5,Args4}.
+
+modifiers([$t|Fmt], Spec) ->
+ modifiers(Fmt, Spec#{encoding => unicode});
+modifiers([$l|Fmt], Spec) ->
+ modifiers(Fmt, Spec#{strings => false});
+modifiers(Fmt, Spec) ->
+ {Spec, Fmt}.
field_width([$-|Fmt0], Args0) ->
{F,Fmt,Args} = field_value(Fmt0, Args0),
@@ -203,40 +229,78 @@ collect_cc([$~|Fmt], Args) when is_list(Args) -> {$~,[],Fmt,Args};
collect_cc([$n|Fmt], Args) when is_list(Args) -> {$n,[],Fmt,Args};
collect_cc([$i|Fmt], [A|Args]) -> {$i,[A],Fmt,Args}.
-%% pcount([ControlC]) -> Count.
-%% Count the number of print requests.
-
-pcount(Cs) -> pcount(Cs, 0).
-
-pcount([#{control_char := $p}|Cs], Acc) -> pcount(Cs, Acc+1);
-pcount([#{control_char := $P}|Cs], Acc) -> pcount(Cs, Acc+1);
-pcount([_|Cs], Acc) -> pcount(Cs, Acc);
-pcount([], Acc) -> Acc.
-
-%% build([Control], Pc, Indentation) -> io_lib:chars().
+%% count_small([ControlC]) -> Count.
+%% Count the number of big (pPwWsS) print requests and
+%% number of characters of other print (small) requests.
+
+count_small(Cs) ->
+ count_small(Cs, #{p => 0, s => 0, w => 0, other => 0}).
+
+count_small([#{control_char := $p}|Cs], #{p := P} = Cnts) ->
+ count_small(Cs, Cnts#{p := P + 1});
+count_small([#{control_char := $P}|Cs], #{p := P} = Cnts) ->
+ count_small(Cs, Cnts#{p := P + 1});
+count_small([#{control_char := $w}|Cs], #{w := W} = Cnts) ->
+ count_small(Cs, Cnts#{w := W + 1});
+count_small([#{control_char := $W}|Cs], #{w := W} = Cnts) ->
+ count_small(Cs, Cnts#{w := W + 1});
+count_small([#{control_char := $s}|Cs], #{w := W} = Cnts) ->
+ count_small(Cs, Cnts#{w := W + 1});
+count_small([S|Cs], #{other := Other} = Cnts) when is_list(S);
+ is_binary(S) ->
+ count_small(Cs, Cnts#{other := Other + string:length(S)});
+count_small([C|Cs], #{other := Other} = Cnts) when is_integer(C) ->
+ count_small(Cs, Cnts#{other := Other + 1});
+count_small([], #{p := P, s := S, w := W, other := Other}) ->
+ {P, S, W, Other}.
+
+%% build_small([Control]) -> io_lib:chars().
+%% Interpret the control structures, but only the small ones.
+%% The big ones are saved for later.
+%% build_limited([Control], NumberOfPps, NumberOfLimited,
+%% CharsLimit, Indentation)
%% Interpret the control structures. Count the number of print
%% remaining and only calculate indentation when necessary. Must also
%% be smart when calculating indentation for characters in format.
-build([#{control_char := C, args := As, width := F, adjust := Ad,
- precision := P, pad_char := Pad, encoding := Enc,
- strings := Str} | Cs], Pc0, I) ->
- S = control(C, As, F, Ad, P, Pad, Enc, Str, I),
- Pc1 = decr_pc(C, Pc0),
+build_small([#{control_char := C, args := As, width := F, adjust := Ad,
+ precision := P, pad_char := Pad, encoding := Enc}=CC | Cs]) ->
+ case control_small(C, As, F, Ad, P, Pad, Enc) of
+ not_small -> [CC | build_small(Cs)];
+ S -> lists:flatten(S) ++ build_small(Cs)
+ end;
+build_small([C|Cs]) -> [C|build_small(Cs)];
+build_small([]) -> [].
+
+build_limited([#{control_char := C, args := As, width := F, adjust := Ad,
+ precision := P, pad_char := Pad, encoding := Enc,
+ strings := Str} | Cs], NumOfPs0, Count0, MaxLen0, I) ->
+ MaxChars = if
+ MaxLen0 < 0 -> MaxLen0;
+ true -> MaxLen0 div Count0
+ end,
+ S = control_limited(C, As, F, Ad, P, Pad, Enc, Str, MaxChars, I),
+ Len = string:length(S),
+ NumOfPs = decr_pc(C, NumOfPs0),
+ Count = Count0 - 1,
+ MaxLen = sub(MaxLen0, Len),
if
- Pc1 > 0 -> [S|build(Cs, Pc1, indentation(S, I))];
- true -> [S|build(Cs, Pc1, I)]
+ NumOfPs > 0 -> [S|build_limited(Cs, NumOfPs, Count,
+ MaxLen, indentation(S, I))];
+ true -> [S|build_limited(Cs, NumOfPs, Count, MaxLen, I)]
end;
-build([$\n|Cs], Pc, _I) -> [$\n|build(Cs, Pc, 0)];
-build([$\t|Cs], Pc, I) -> [$\t|build(Cs, Pc, ((I + 8) div 8) * 8)];
-build([C|Cs], Pc, I) -> [C|build(Cs, Pc, I+1)];
-build([], _Pc, _I) -> [].
+build_limited([$\n|Cs], NumOfPs, Count, MaxLen, _I) ->
+ [$\n|build_limited(Cs, NumOfPs, Count, MaxLen, 0)];
+build_limited([$\t|Cs], NumOfPs, Count, MaxLen, I) ->
+ [$\t|build_limited(Cs, NumOfPs, Count, MaxLen, ((I + 8) div 8) * 8)];
+build_limited([C|Cs], NumOfPs, Count, MaxLen, I) ->
+ [C|build_limited(Cs, NumOfPs, Count, MaxLen, I+1)];
+build_limited([], _, _, _, _) -> [].
decr_pc($p, Pc) -> Pc - 1;
decr_pc($P, Pc) -> Pc - 1;
decr_pc(_, Pc) -> Pc.
-
%% Calculate the indentation of the end of a string given its start
%% indentation. We assume tabs at 8 cols.
@@ -252,67 +316,74 @@ indentation([C|Cs], I) ->
indentation(Cs, indentation(C, I));
indentation([], I) -> I.
-%% control(FormatChar, [Argument], FieldWidth, Adjust, Precision, PadChar,
-%% Encoding, Indentation) -> String
-%% This is the main dispatch function for the various formatting commands.
-%% Field widths and precisions have already been calculated.
-
-control($w, [A], F, Adj, P, Pad, Enc, _Str, _I) ->
- term(io_lib:write(A, [{depth,-1}, {encoding, Enc}]), F, Adj, P, Pad);
-control($p, [A], F, Adj, P, Pad, Enc, Str, I) ->
- print(A, -1, F, Adj, P, Pad, Enc, Str, I);
-control($W, [A,Depth], F, Adj, P, Pad, Enc, _Str, _I) when is_integer(Depth) ->
- term(io_lib:write(A, [{depth,Depth}, {encoding, Enc}]), F, Adj, P, Pad);
-control($P, [A,Depth], F, Adj, P, Pad, Enc, Str, I) when is_integer(Depth) ->
- print(A, Depth, F, Adj, P, Pad, Enc, Str, I);
-control($s, [A], F, Adj, P, Pad, latin1, _Str, _I) when is_atom(A) ->
+%% control_small(FormatChar, [Argument], FieldWidth, Adjust, Precision,
+%% PadChar, Encoding) -> String
+%% control_limited(FormatChar, [Argument], FieldWidth, Adjust, Precision,
+%% PadChar, Encoding, StringP, ChrsLim, Indentation) -> String
+%% These are the dispatch functions for the various formatting controls.
+
+control_small($s, [A], F, Adj, P, Pad, latin1) when is_atom(A) ->
L = iolist_to_chars(atom_to_list(A)),
string(L, F, Adj, P, Pad);
-control($s, [A], F, Adj, P, Pad, unicode, _Str, _I) when is_atom(A) ->
+control_small($s, [A], F, Adj, P, Pad, unicode) when is_atom(A) ->
string(atom_to_list(A), F, Adj, P, Pad);
-control($s, [L0], F, Adj, P, Pad, latin1, _Str, _I) ->
- L = iolist_to_chars(L0),
- string(L, F, Adj, P, Pad);
-control($s, [L0], F, Adj, P, Pad, unicode, _Str, _I) ->
- L = cdata_to_chars(L0),
- uniconv(string(L, F, Adj, P, Pad));
-control($e, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_float(A) ->
+control_small($e, [A], F, Adj, P, Pad, _Enc) when is_float(A) ->
fwrite_e(A, F, Adj, P, Pad);
-control($f, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_float(A) ->
+control_small($f, [A], F, Adj, P, Pad, _Enc) when is_float(A) ->
fwrite_f(A, F, Adj, P, Pad);
-control($g, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_float(A) ->
+control_small($g, [A], F, Adj, P, Pad, _Enc) when is_float(A) ->
fwrite_g(A, F, Adj, P, Pad);
-control($b, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) ->
+control_small($b, [A], F, Adj, P, Pad, _Enc) when is_integer(A) ->
unprefixed_integer(A, F, Adj, base(P), Pad, true);
-control($B, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) ->
+control_small($B, [A], F, Adj, P, Pad, _Enc) when is_integer(A) ->
unprefixed_integer(A, F, Adj, base(P), Pad, false);
-control($x, [A,Prefix], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A),
- is_atom(Prefix) ->
+control_small($x, [A,Prefix], F, Adj, P, Pad, _Enc) when is_integer(A),
+ is_atom(Prefix) ->
prefixed_integer(A, F, Adj, base(P), Pad, atom_to_list(Prefix), true);
-control($x, [A,Prefix], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) ->
+control_small($x, [A,Prefix], F, Adj, P, Pad, _Enc) when is_integer(A) ->
true = io_lib:deep_char_list(Prefix), %Check if Prefix a character list
prefixed_integer(A, F, Adj, base(P), Pad, Prefix, true);
-control($X, [A,Prefix], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A),
- is_atom(Prefix) ->
+control_small($X, [A,Prefix], F, Adj, P, Pad, _Enc) when is_integer(A),
+ is_atom(Prefix) ->
prefixed_integer(A, F, Adj, base(P), Pad, atom_to_list(Prefix), false);
-control($X, [A,Prefix], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) ->
+control_small($X, [A,Prefix], F, Adj, P, Pad, _Enc) when is_integer(A) ->
true = io_lib:deep_char_list(Prefix), %Check if Prefix a character list
prefixed_integer(A, F, Adj, base(P), Pad, Prefix, false);
-control($+, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) ->
+control_small($+, [A], F, Adj, P, Pad, _Enc) when is_integer(A) ->
Base = base(P),
Prefix = [integer_to_list(Base), $#],
prefixed_integer(A, F, Adj, Base, Pad, Prefix, true);
-control($#, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) ->
+control_small($#, [A], F, Adj, P, Pad, _Enc) when is_integer(A) ->
Base = base(P),
Prefix = [integer_to_list(Base), $#],
prefixed_integer(A, F, Adj, Base, Pad, Prefix, false);
-control($c, [A], F, Adj, P, Pad, unicode, _Str, _I) when is_integer(A) ->
+control_small($c, [A], F, Adj, P, Pad, unicode) when is_integer(A) ->
char(A, F, Adj, P, Pad);
-control($c, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) ->
+control_small($c, [A], F, Adj, P, Pad, _Enc) when is_integer(A) ->
char(A band 255, F, Adj, P, Pad);
-control($~, [], F, Adj, P, Pad, _Enc, _Str, _I) -> char($~, F, Adj, P, Pad);
-control($n, [], F, Adj, P, Pad, _Enc, _Str, _I) -> newline(F, Adj, P, Pad);
-control($i, [_A], _F, _Adj, _P, _Pad, _Enc, _Str, _I) -> [].
+control_small($~, [], F, Adj, P, Pad, _Enc) -> char($~, F, Adj, P, Pad);
+control_small($n, [], F, Adj, P, Pad, _Enc) -> newline(F, Adj, P, Pad);
+control_small($i, [_A], _F, _Adj, _P, _Pad, _Enc) -> [];
+control_small(_C, _As, _F, _Adj, _P, _Pad, _Enc) -> not_small.
+
+control_limited($s, [L0], F, Adj, P, Pad, latin1, _Str, CL, _I) ->
+ L = iolist_to_chars(L0),
+ string(limit_string(L, F, CL), limit_field(F, CL), Adj, P, Pad);
+control_limited($s, [L0], F, Adj, P, Pad, unicode, _Str, CL, _I) ->
+ L = cdata_to_chars(L0),
+ uniconv(string(limit_string(L, F, CL), limit_field(F, CL), Adj, P, Pad));
+control_limited($w, [A], F, Adj, P, Pad, Enc, _Str, CL, _I) ->
+ Chars = io_lib:write(A, [{depth, -1}, {encoding, Enc}, {chars_limit, CL}]),
+ term(Chars, F, Adj, P, Pad);
+control_limited($p, [A], F, Adj, P, Pad, Enc, Str, CL, I) ->
+ print(A, -1, F, Adj, P, Pad, Enc, Str, CL, I);
+control_limited($W, [A,Depth], F, Adj, P, Pad, Enc, _Str, CL, _I)
+ when is_integer(Depth) ->
+ Chars = io_lib:write(A, [{depth, Depth}, {encoding, Enc}, {chars_limit, CL}]),
+ term(Chars, F, Adj, P, Pad);
+control_limited($P, [A,Depth], F, Adj, P, Pad, Enc, Str, CL, I)
+ when is_integer(Depth) ->
+ print(A, Depth, F, Adj, P, Pad, Enc, Str, CL, I).
-ifdef(UNICODE_AS_BINARIES).
uniconv(C) ->
@@ -349,12 +420,13 @@ term(T, F, Adj, P0, Pad) ->
%% Print a term. Field width sets maximum line length, Precision sets
%% initial indentation.
-print(T, D, none, Adj, P, Pad, E, Str, I) ->
- print(T, D, 80, Adj, P, Pad, E, Str, I);
-print(T, D, F, Adj, none, Pad, E, Str, I) ->
- print(T, D, F, Adj, I+1, Pad, E, Str, I);
-print(T, D, F, right, P, _Pad, Enc, Str, _I) ->
- Options = [{column, P},
+print(T, D, none, Adj, P, Pad, E, Str, ChLim, I) ->
+ print(T, D, 80, Adj, P, Pad, E, Str, ChLim, I);
+print(T, D, F, Adj, none, Pad, E, Str, ChLim, I) ->
+ print(T, D, F, Adj, I+1, Pad, E, Str, ChLim, I);
+print(T, D, F, right, P, _Pad, Enc, Str, ChLim, _I) ->
+ Options = [{chars_limit, ChLim},
+ {column, P},
{line_length, F},
{depth, D},
{encoding, Enc},
@@ -380,7 +452,7 @@ float_e(_Fl, {Ds,E}, P) ->
{Fs,false} -> [Fs|float_exp(E-1)]
end.
-%% float_man([Digit], Icount, Dcount) -> {[Chars],CarryFlag}.
+%% float_man([Digit], Icount, Dcount) -> {[Char],CarryFlag}.
%% Generate the characters in the mantissa from the digits with Icount
%% characters before the '.' and Dcount decimals. Handle carry and let
%% caller decide what to do at top.
@@ -395,7 +467,7 @@ float_man([D|Ds], I, Dc) ->
{Cs,false} -> {[D|Cs],false}
end;
float_man([], I, Dc) -> %Pad with 0's
- {string:chars($0, I, [$.|string:chars($0, Dc)]),false}.
+ {lists:duplicate(I, $0) ++ [$.|lists:duplicate(Dc, $0)],false}.
float_man([D|_], 0) when D >= $5 -> {[],true};
float_man([_|_], 0) -> {[],false};
@@ -405,7 +477,7 @@ float_man([D|Ds], Dc) ->
{Cs,true} -> {[D+1|Cs],false};
{Cs,false} -> {[D|Cs],false}
end;
-float_man([], Dc) -> {string:chars($0, Dc),false}. %Pad with 0's
+float_man([], Dc) -> {lists:duplicate(Dc, $0),false}. %Pad with 0's
%% float_exp(Exponent) -> [Char].
%% Generate the exponent of a floating point number. Always include sign.
@@ -429,7 +501,7 @@ fwrite_f(Fl, F, Adj, P, Pad) when P >= 1 ->
float_f(Fl, Fd, P) when Fl < 0.0 ->
[$-|float_f(-Fl, Fd, P)];
float_f(Fl, {Ds,E}, P) when E =< 0 ->
- float_f(Fl, {string:chars($0, -E+1, Ds),1}, P); %Prepend enough 0's
+ float_f(Fl, {lists:duplicate(-E+1, $0)++Ds,1}, P); %Prepend enough 0's
float_f(_Fl, {Ds,E}, P) ->
case float_man(Ds, E, P) of
{Fs,true} -> "1" ++ Fs; %Handle carry
@@ -671,6 +743,18 @@ cdata_to_chars(B) when is_binary(B) ->
_ -> binary_to_list(B)
end.
+limit_string(S, F, CharsLimit) when CharsLimit < 0; CharsLimit >= F -> S;
+limit_string(S, _F, CharsLimit) ->
+ case string:length(S) =< CharsLimit of
+ true -> S;
+ false -> [string:slice(S, 0, sub(CharsLimit, 3)), "..."]
+ end.
+
+limit_field(F, CharsLimit) when CharsLimit < 0; F =:= none ->
+ F;
+limit_field(F, CharsLimit) ->
+ max(3, min(F, CharsLimit)).
+
%% string(String, Field, Adjust, Precision, PadChar)
string(S, none, _Adj, none, _Pad) -> S;
@@ -751,7 +835,7 @@ adjust(Data, Pad, right) -> [Pad|Data].
flat_trunc(List, N) when is_integer(N), N >= 0 ->
string:slice(List, 0, N).
-%% A deep version of string:chars/2,3
+%% A deep version of lists:duplicate/2
chars(_C, 0) ->
[];
@@ -784,3 +868,15 @@ lowercase([H|T]) ->
[H|lowercase(T)];
lowercase([]) ->
[].
+
+%% Make sure T does change sign.
+sub(T, _) when T < 0 -> T;
+sub(T, E) when T >= E -> T - E;
+sub(_, _) -> 0.
+
+get_option(Key, TupleList, Default) ->
+ case lists:keyfind(Key, 1, TupleList) of
+ false -> Default;
+ {Key, Value} -> Value;
+ _ -> Default
+ end.
diff --git a/lib/stdlib/src/io_lib_pretty.erl b/lib/stdlib/src/io_lib_pretty.erl
index 505613b80e..ba9d9e8434 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-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -26,6 +26,9 @@
-export([print/1,print/2,print/3,print/4,print/5,print/6]).
+%% To be used by io_lib only.
+-export([intermediate/6, write/1]).
+
%%%
%%% Exported functions
%%%
@@ -45,20 +48,23 @@ print(Term) ->
%% Used by the shell for printing records and for Unicode.
-type rec_print_fun() :: fun((Tag :: atom(), NFields :: non_neg_integer()) ->
- no | [FieldName :: atom()]).
+ 'no' | [FieldName :: atom()]).
-type column() :: integer().
+-type encoding() :: epp:source_encoding() | 'unicode'.
-type line_length() :: pos_integer().
-type depth() :: integer().
--type max_chars() :: integer().
+-type line_max_chars() :: integer().
+-type chars_limit() :: integer().
-type chars() :: io_lib:chars().
--type option() :: {column, column()}
- | {line_length, line_length()}
- | {depth, depth()}
- | {max_chars, max_chars()}
- | {record_print_fun, rec_print_fun()}
- | {strings, boolean()}
- | {encoding, latin1 | utf8 | unicode}.
+-type option() :: {'chars_limit', chars_limit()}
+ | {'column', column()}
+ | {'depth', depth()}
+ | {'encoding', encoding()}
+ | {'line_length', line_length()}
+ | {'line_max_chars', line_max_chars()}
+ | {'record_print_fun', rec_print_fun()}
+ | {'strings', boolean()}.
-type options() :: [option()].
-spec print(term(), rec_print_fun()) -> chars();
@@ -68,11 +74,12 @@ print(Term, Options) when is_list(Options) ->
Col = get_option(column, Options, 1),
Ll = get_option(line_length, Options, 80),
D = get_option(depth, Options, -1),
- M = get_option(max_chars, Options, -1),
+ M = get_option(line_max_chars, Options, -1),
+ T = get_option(chars_limit, Options, -1),
RecDefFun = get_option(record_print_fun, Options, no_fun),
Encoding = get_option(encoding, Options, epp:default_encoding()),
Strings = get_option(strings, Options, true),
- print(Term, Col, Ll, D, M, RecDefFun, Encoding, Strings);
+ print(Term, Col, Ll, D, M, T, RecDefFun, Encoding, Strings);
print(Term, RecDefFun) ->
print(Term, -1, RecDefFun).
@@ -84,38 +91,48 @@ print(Term, Depth, RecDefFun) ->
-spec print(term(), column(), line_length(), depth()) -> chars().
print(Term, Col, Ll, D) ->
- print(Term, Col, Ll, D, _M=-1, no_fun, latin1, true).
+ print(Term, Col, Ll, D, _M=-1, _T=-1, no_fun, latin1, true).
-spec print(term(), column(), line_length(), depth(), rec_print_fun()) ->
chars().
print(Term, Col, Ll, D, RecDefFun) ->
print(Term, Col, Ll, D, _M=-1, RecDefFun).
--spec print(term(), column(), line_length(), depth(), max_chars(),
+-spec print(term(), column(), line_length(), depth(), line_max_chars(),
rec_print_fun()) -> chars().
print(Term, Col, Ll, D, M, RecDefFun) ->
- print(Term, Col, Ll, D, M, RecDefFun, latin1, true).
+ print(Term, Col, Ll, D, M, _T=-1, RecDefFun, latin1, true).
%% D = Depth, default -1 (infinite), or LINEMAX=30 when printing from shell
+%% T = chars_limit, that is, maximal number of characters, default -1
+%% Used together with D to limit the output. It is possible that
+%% more than T characters are returned.
%% Col = current column, default 1
%% Ll = line length/~p field width, default 80
%% M = CHAR_MAX (-1 if no max, 60 when printing from shell)
-print(_, _, _, 0, _M, _RF, _Enc, _Str) -> "...";
-print(Term, Col, Ll, D, M, RecDefFun, Enc, Str) when Col =< 0 ->
+print(_, _, _, 0, _M, _T, _RF, _Enc, _Str) -> "...";
+print(_, _, _, _D, _M, 0, _RF, _Enc, _Str) -> "...";
+print(Term, Col, Ll, D, M, T, RecDefFun, Enc, Str) when Col =< 0 ->
%% ensure Col is at least 1
- print(Term, 1, Ll, D, M, RecDefFun, Enc, Str);
-print(Atom, _Col, _Ll, _D, _M, _RF, Enc, _Str) when is_atom(Atom) ->
+ print(Term, 1, Ll, D, M, T, RecDefFun, Enc, Str);
+print(Atom, _Col, _Ll, _D, _M, _T, _RF, Enc, _Str) when is_atom(Atom) ->
write_atom(Atom, Enc);
-print(Term, Col, Ll, D, M0, RecDefFun, Enc, Str) when is_tuple(Term);
- is_list(Term);
- is_map(Term);
- is_bitstring(Term) ->
+print(Term, Col, Ll, D, M0, T, RecDefFun, Enc, Str) when is_tuple(Term);
+ is_list(Term);
+ is_map(Term);
+ is_bitstring(Term) ->
%% preprocess and compute total number of chars
- If = {_S, Len} = print_length(Term, D, RecDefFun, Enc, Str),
+ {_, Len, _Dots, _} = If =
+ case T < 0 of
+ true -> print_length(Term, D, T, RecDefFun, Enc, Str);
+ false -> intermediate(Term, D, T, RecDefFun, Enc, Str)
+ end,
%% use Len as CHAR_MAX if M0 = -1
M = max_cs(M0, Len),
if
+ Ll =:= 0 ->
+ write(If);
Len < Ll - Col, Len =< M ->
%% write the whole thing on a single line when there is room
write(If);
@@ -126,7 +143,7 @@ print(Term, Col, Ll, D, M0, RecDefFun, Enc, Str) when is_tuple(Term);
1),
pp(If, Col, Ll, M, TInd, indent(Col), 0, 0)
end;
-print(Term, _Col, _Ll, _D, _M, _RF, _Enc, _Str) ->
+print(Term, _Col, _Ll, _D, _M, _T, _RF, _Enc, _Str) ->
%% atomic data types (bignums, atoms, ...) are never truncated
io_lib:write(Term).
@@ -147,28 +164,28 @@ max_cs(M, _Len) ->
?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)
+pp({_S,Len,_,_} = If, Col, Ll, M, _TInd, _Ind, LD, W)
when Len < Ll - Col - LD, Len + W + LD =< M ->
write(If);
-pp({{list,L}, _Len}, Col, Ll, M, TInd, Ind, LD, W) ->
+pp({{list,L}, _Len, _, _}, Col, Ll, M, TInd, Ind, LD, W) ->
[$[, pp_list(L, Col + 1, Ll, M, TInd, indent(1, Ind), LD, $|, W + 1), $]];
-pp({{tuple,true,L}, _Len}, Col, Ll, M, TInd, Ind, LD, W) ->
+pp({{tuple,true,L}, _Len, _, _}, Col, Ll, M, TInd, Ind, LD, W) ->
[${, pp_tag_tuple(L, Col, Ll, M, TInd, Ind, LD, W + 1), $}];
-pp({{tuple,false,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({{map,Pairs}, _Len, _, _}, 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) ->
+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) ->
+pp({{bin,S}, _Len, _, _}, Col, Ll, M, _TInd, Ind, LD, W) ->
pp_binary(S, Col + 2, Ll, M, indent(2, Ind), LD, W);
-pp({S, _Len}, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
+pp({S,_Len,_,_}, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
S.
%% Print a tagged tuple by indenting the rest of the elements
%% differently to the tag. Tuple has size >= 2.
-pp_tag_tuple([{Tag,Tlen} | L], Col, Ll, M, TInd, Ind, LD, W) ->
+pp_tag_tuple([{Tag,Tlen,_,_} | L], Col, Ll, M, TInd, Ind, LD, W) ->
%% this uses TInd
TagInd = Tlen + 2,
Tcol = Col + TagInd,
@@ -184,18 +201,18 @@ pp_tag_tuple([{Tag,Tlen} | L], Col, Ll, M, TInd, Ind, LD, W) ->
end.
pp_map([], _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
- "";
-pp_map({dots, _}, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
- "...";
+ ""; % cannot happen
+pp_map({dots, _, _, _}, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
+ "..."; % cannot happen
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({dots, _, _, _}, _Col0, _Col, _M, _Ll, _TInd, _Ind, _LD, _W) ->
",...";
-pp_pairs_tail([{_, Len}=P | Ps], Col0, Col, Ll, M, 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
@@ -209,7 +226,7 @@ pp_pairs_tail([{_, Len}=P | Ps], Col0, Col, Ll, M, TInd, Ind, LD, W) ->
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)
+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) ->
@@ -217,7 +234,7 @@ pp_pair({_, Len}=Pair, Col, Ll, M, _TInd, _Ind, LD, W)
true ->
Ll % force nl
end};
-pp_pair({{map_pair, K, V}, _Len}, Col0, Ll, M, TInd, Ind0, LD, W) ->
+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",
@@ -225,7 +242,7 @@ pp_pair({{map_pair, K, V}, _Len}, Col0, Ll, M, TInd, Ind0, LD, W) ->
pp_record([], _Nlen, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
"";
-pp_record({dots, _}, _Nlen, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
+pp_record({dots, _, _, _}, _Nlen, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
"...";
pp_record([F | Fs], Nlen, Col0, Ll, M, TInd, Ind0, LD, W0) ->
Nind = Nlen + 1,
@@ -235,9 +252,9 @@ pp_record([F | Fs], Nlen, Col0, Ll, M, TInd, Ind0, LD, W0) ->
pp_fields_tail([], _Col0, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
"";
-pp_fields_tail({dots, _}, _Col0, _Col, _M, _Ll, _TInd, _Ind, _LD, _W) ->
+pp_fields_tail({dots, _, _ ,_}, _Col0, _Col, _M, _Ll, _TInd, _Ind, _LD, _W) ->
",...";
-pp_fields_tail([{_, Len}=F | Fs], Col0, Col, Ll, M, TInd, Ind, LD, W) ->
+pp_fields_tail([{_, Len, _, _}=F | Fs], Col0, Col, Ll, M, TInd, Ind, LD, W) ->
LD1 = last_depth(Fs, LD),
ELen = 1 + Len,
if
@@ -251,7 +268,7 @@ pp_fields_tail([{_, Len}=F | Fs], Col0, Col, Ll, M, TInd, Ind, LD, W) ->
pp_fields_tail(Fs, Col0, Col0 + FW, Ll, M, TInd, Ind, LD, FW)]
end.
-pp_field({_, Len}=Fl, Col, Ll, M, _TInd, _Ind, LD, W)
+pp_field({_, Len, _, _}=Fl, Col, Ll, M, _TInd, _Ind, LD, W)
when Len < Ll - Col - LD, Len + W + LD =< M ->
{write_field(Fl), if
?ATM_FLD(Fl) ->
@@ -259,7 +276,7 @@ pp_field({_, Len}=Fl, Col, Ll, M, _TInd, _Ind, LD, W)
true ->
Ll % force nl
end};
-pp_field({{field, Name, NameL, F}, _Len}, Col0, Ll, M, TInd, Ind0, LD, W0) ->
+pp_field({{field, Name, NameL, F},_,_, _}, Col0, Ll, M, TInd, Ind0, LD, W0) ->
{Col, Ind, S, W} = rec_indent(NameL, TInd, Col0, Ind0, W0 + NameL),
Sep = case S of
[$\n | _] -> " =";
@@ -286,15 +303,15 @@ rec_indent(RInd, TInd, Col0, Ind0, W0) ->
end,
{Col, Ind, S, W}.
-pp_list({dots, _}, _Col0, _Ll, _M, _TInd, _Ind, _LD, _S, _W) ->
+pp_list({dots, _, _, _}, _Col0, _Ll, _M, _TInd, _Ind, _LD, _S, _W) ->
"...";
pp_list([E | Es], Col0, Ll, M, TInd, Ind, LD, S, W) ->
{ES, WE} = pp_element(E, Col0, Ll, M, TInd, Ind, last_depth(Es, LD), W),
[ES | pp_tail(Es, Col0, Col0 + WE, Ll, M, TInd, Ind, LD, S, W + WE)].
pp_tail([], _Col0, _Col, _Ll, _M, _TInd, _Ind, _LD, _S, _W) ->
- "";
-pp_tail([{_, Len}=E | Es], Col0, Col, Ll, M, TInd, Ind, LD, S, W) ->
+ [];
+pp_tail([{_, Len, _, _}=E | Es], Col0, Col, Ll, M, TInd, Ind, LD, S, W) ->
LD1 = last_depth(Es, LD),
ELen = 1 + Len,
if
@@ -307,9 +324,9 @@ pp_tail([{_, Len}=E | Es], Col0, Col, Ll, M, TInd, Ind, LD, S, W) ->
[$,, $\n, Ind, ES |
pp_tail(Es, Col0, Col0 + WE, Ll, M, TInd, Ind, LD, S, WE)]
end;
-pp_tail({dots, _}, _Col0, _Col, _Ll, _M, _TInd, _Ind, _LD, S, _W) ->
+pp_tail({dots, _, _, _}, _Col0, _Col, _Ll, _M, _TInd, _Ind, _LD, S, _W) ->
[S | "..."];
-pp_tail({_, Len}=E, _Col0, Col, Ll, M, _TInd, _Ind, LD, S, W)
+pp_tail({_, Len, _, _}=E, _Col0, Col, Ll, M, _TInd, _Ind, LD, S, W)
when Len + 1 < Ll - Col - (LD + 1),
Len + 1 + W + (LD + 1) =< M,
?ATM(E) ->
@@ -317,7 +334,7 @@ pp_tail({_, Len}=E, _Col0, Col, Ll, M, _TInd, _Ind, LD, S, W)
pp_tail(E, Col0, _Col, Ll, M, TInd, Ind, LD, S, _W) ->
[S, $\n, Ind | pp(E, Col0, Ll, M, TInd, Ind, LD + 1, 0)].
-pp_element({_, Len}=E, Col, Ll, M, _TInd, _Ind, LD, W)
+pp_element({_, Len, _, _}=E, Col, Ll, M, _TInd, _Ind, LD, W)
when Len < Ll - Col - LD, Len + W + LD =< M, ?ATM(E) ->
{write(E), Len};
pp_element(E, Col, Ll, M, TInd, Ind, LD, W) ->
@@ -348,42 +365,42 @@ pp_binary(S, N, _N0, Ind) ->
end.
%% write the whole thing on a single line
-write({{tuple, _IsTagged, L}, _}) ->
+write({{tuple, _IsTagged, L}, _, _, _}) ->
[${, write_list(L, $,), $}];
-write({{list, L}, _}) ->
+write({{list, L}, _, _, _}) ->
[$[, write_list(L, $|), $]];
-write({{map, Pairs}, _}) ->
+write({{map, Pairs}, _, _, _}) ->
[$#,${, write_list(Pairs, $,), $}];
-write({{map_pair, _K, _V}, _}=Pair) ->
+write({{map_pair, _K, _V}, _, _, _}=Pair) ->
write_pair(Pair);
-write({{record, [{Name,_} | L]}, _}) ->
+write({{record, [{Name,_} | L]}, _, _, _}) ->
[Name, ${, write_fields(L), $}];
-write({{bin, S}, _}) ->
+write({{bin, S}, _, _, _}) ->
S;
-write({S, _}) ->
+write({S, _, _, _}) ->
S.
-write_pair({{map_pair, K, V}, _}) ->
+write_pair({{map_pair, K, V}, _, _, _}) ->
[write(K), " => ", write(V)].
write_fields([]) ->
"";
-write_fields({dots, _}) ->
+write_fields({dots, _, _, _}) ->
"...";
write_fields([F | Fs]) ->
[write_field(F) | write_fields_tail(Fs)].
write_fields_tail([]) ->
"";
-write_fields_tail({dots, _}) ->
+write_fields_tail({dots, _, _, _}) ->
",...";
write_fields_tail([F | Fs]) ->
[$,, write_field(F) | write_fields_tail(Fs)].
-write_field({{field, Name, _NameL, F}, _}) ->
+write_field({{field, Name, _NameL, F}, _, _, _}) ->
[Name, " = " | write(F)].
-write_list({dots, _}, _S) ->
+write_list({dots, _, _, _}, _S) ->
"...";
write_list([E | Es], S) ->
[write(E) | write_tail(Es, S)].
@@ -392,182 +409,365 @@ write_tail([], _S) ->
[];
write_tail([E | Es], S) ->
[$,, write(E) | write_tail(Es, S)];
-write_tail({dots, _}, S) ->
+write_tail({dots, _, _, _}, S) ->
[S | "..."];
write_tail(E, S) ->
[S | write(E)].
+-type more() :: fun((chars_limit(), DeltaDepth :: non_neg_integer()) ->
+ intermediate_format()).
+
+-type if_list() :: maybe_improper_list(intermediate_format(),
+ {'dots', non_neg_integer(),
+ non_neg_integer(), more()}).
+
+-type intermediate_format() ::
+ {chars()
+ | {'bin', chars()}
+ | 'dots'
+ | {'field', Name :: chars(), NameLen :: non_neg_integer(),
+ intermediate_format()}
+ | {'list', if_list()}
+ | {'map', if_list()}
+ | {'map_pair', K :: intermediate_format(),
+ V :: intermediate_format()}
+ | {'record', [{Name :: chars(), NameLen :: non_neg_integer()}
+ | if_list()]}
+ | {'tuple', IsTagged :: boolean(), if_list()},
+ Len :: non_neg_integer(),
+ NumOfDots :: non_neg_integer(),
+ More :: more() | 'no_more'
+ }.
+
+-spec intermediate(term(), depth(), pos_integer(), rec_print_fun(),
+ encoding(), boolean()) -> intermediate_format().
+
+intermediate(Term, D, T, RF, Enc, Str) when T > 0 ->
+ D0 = 1,
+ If = print_length(Term, D0, T, RF, Enc, Str),
+ case If of
+ {_, Len, Dots, _} when Dots =:= 0; Len > T; D =:= 1 ->
+ If;
+ _ ->
+ find_upper(If, Term, T, D0, 2, D, RF, Enc, Str)
+ end.
+
+find_upper(Lower, Term, T, Dl, Dd, D, RF, Enc, Str) ->
+ Dd2 = Dd * 2,
+ D1 = case D < 0 of
+ true -> Dl + Dd2;
+ false -> min(Dl + Dd2, D)
+ end,
+ If = expand(Lower, T, D1 - Dl),
+ case If of
+ {_, _, _Dots=0, _} -> % even if Len > T
+ If;
+ {_, Len, _, _} when Len =< T, D1 < D orelse D < 0 ->
+ find_upper(If, Term, T, D1, Dd2, D, RF, Enc, Str);
+ _ ->
+ search_depth(Lower, If, Term, T, Dl, D1, RF, Enc, Str)
+ end.
+
+%% Lower has NumOfDots > 0 and Len =< T.
+%% Upper has NumOfDots > 0 and Len > T.
+search_depth(Lower, Upper, _Term, T, Dl, Du, _RF, _Enc, _Str)
+ when Du - Dl =:= 1 ->
+ %% The returned intermediate format has Len >= T.
+ case Lower of
+ {_, T, _, _} ->
+ Lower;
+ _ ->
+ Upper
+ end;
+search_depth(Lower, Upper, Term, T, Dl, Du, RF, Enc, Str) ->
+ D1 = (Dl + Du) div 2,
+ If = expand(Lower, T, D1 - Dl),
+ case If of
+ {_, Len, _, _} when Len > T ->
+ %% Len can be greater than Upper's length.
+ %% This is a bit expensive since the work to
+ %% crate Upper is wasted. It is the price
+ %% to pay to get a more balanced output.
+ search_depth(Lower, If, Term, T, Dl, D1, RF, Enc, Str);
+ _ ->
+ search_depth(If, Upper, Term, T, D1, Du, RF, Enc, Str)
+ end.
+
%% 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, map) are
%% counted but need to be added later.
%% D =/= 0
-print_length([], _D, _RF, _Enc, _Str) ->
- {"[]", 2};
-print_length({}, _D, _RF, _Enc, _Str) ->
- {"{}", 2};
-print_length(#{}=M, _D, _RF, _Enc, _Str) when map_size(M) =:= 0 ->
- {"#{}", 3};
-print_length(Atom, _D, _RF, Enc, _Str) when is_atom(Atom) ->
+print_length([], _D, _T, _RF, _Enc, _Str) ->
+ {"[]", 2, 0, no_more};
+print_length({}, _D, _T, _RF, _Enc, _Str) ->
+ {"{}", 2, 0, no_more};
+print_length(#{}=M, _D, _T, _RF, _Enc, _Str) when map_size(M) =:= 0 ->
+ {"#{}", 3, 0, no_more};
+print_length(Atom, _D, _T, _RF, Enc, _Str) when is_atom(Atom) ->
S = write_atom(Atom, Enc),
- {S, lists:flatlength(S)};
-print_length(List, D, RF, Enc, Str) when is_list(List) ->
+ {S, string:length(S), 0, no_more};
+print_length(List, D, T, RF, Enc, Str) when is_list(List) ->
%% only flat lists are "printable"
- case Str andalso printable_list(List, D, Enc) of
+ case Str andalso printable_list(List, D, T, Enc) of
true ->
%% print as string, escaping double-quotes in the list
S = write_string(List, Enc),
- {S, length(S)};
- %% Truncated lists could break some existing code.
- % {true, Prefix} ->
- % S = write_string(Prefix, Enc),
- % {[S | "..."], 3 + length(S)};
+ {S, string:length(S), 0, no_more};
+ {true, Prefix} ->
+ %% Truncated lists when T < 0 could break some existing code.
+ S = write_string(Prefix, Enc),
+ %% NumOfDots = 0 to avoid looping--increasing the depth
+ %% does not make Prefix longer.
+ {[S | "..."], 3 + string:length(S), 0, no_more};
false ->
- print_length_list(List, D, RF, Enc, Str)
+ case print_length_list(List, D, T, RF, Enc, Str) of
+ {What, Len, Dots, _More} when Dots > 0 ->
+ More = fun(T1, Dd) ->
+ ?FUNCTION_NAME(List, D+Dd, T1, RF, Enc, Str)
+ end,
+ {What, Len, Dots, More};
+ If ->
+ If
+ end
end;
-print_length(Fun, _D, _RF, _Enc, _Str) when is_function(Fun) ->
+print_length(Fun, _D, _T, _RF, _Enc, _Str) when is_function(Fun) ->
S = io_lib:write(Fun),
- {S, iolist_size(S)};
-print_length(R, D, RF, Enc, Str) when is_atom(element(1, R)),
- is_function(RF) ->
+ {S, iolist_size(S), 0, no_more};
+print_length(R, D, T, RF, Enc, Str) when is_atom(element(1, R)),
+ is_function(RF) ->
case RF(element(1, R), tuple_size(R) - 1) of
no ->
- print_length_tuple(R, D, RF, Enc, Str);
+ print_length_tuple(R, D, T, RF, Enc, Str);
RDefs ->
- print_length_record(R, D, RF, RDefs, Enc, Str)
+ print_length_record(R, D, T, RF, RDefs, Enc, Str)
end;
-print_length(Tuple, D, RF, Enc, Str) when is_tuple(Tuple) ->
- print_length_tuple(Tuple, D, RF, Enc, Str);
-print_length(Map, D, RF, Enc, Str) when is_map(Map) ->
- print_length_map(Map, D, RF, Enc, Str);
-print_length(<<>>, _D, _RF, _Enc, _Str) ->
- {"<<>>", 4};
-print_length(<<_/bitstring>>, 1, _RF, _Enc, _Str) ->
- {"<<...>>", 7};
-print_length(<<_/bitstring>>=Bin, D, _RF, Enc, Str) ->
- case bit_size(Bin) rem 8 of
- 0 ->
- D1 = D - 1,
- case Str andalso printable_bin(Bin, D1, Enc) of
- {true, List} when is_list(List) ->
- S = io_lib:write_string(List, $"), %"
- {[$<,$<,S,$>,$>], 4 + length(S)};
- {false, List} when is_list(List) ->
- S = io_lib:write_string(List, $"), %"
- {[$<,$<,S,"/utf8>>"], 9 + length(S)};
- {true, true, Prefix} ->
- S = io_lib:write_string(Prefix, $"), %"
- {[$<,$<, S | "...>>"], 7 + length(S)};
- {false, true, Prefix} ->
- S = io_lib:write_string(Prefix, $"), %"
- {[$<,$<, S | "/utf8...>>"], 12 + length(S)};
- false ->
- S = io_lib:write(Bin, D),
- {{bin,S}, iolist_size(S)}
- end;
- _ ->
- S = io_lib:write(Bin, D),
- {{bin,S}, iolist_size(S)}
+print_length(Tuple, D, T, RF, Enc, Str) when is_tuple(Tuple) ->
+ print_length_tuple(Tuple, D, T, RF, Enc, Str);
+print_length(Map, D, T, RF, Enc, Str) when is_map(Map) ->
+ print_length_map(Map, D, T, RF, Enc, Str);
+print_length(<<>>, _D, _T, _RF, _Enc, _Str) ->
+ {"<<>>", 4, 0, no_more};
+print_length(<<_/bitstring>> = Bin, 1, _T, RF, Enc, Str) ->
+ More = fun(T1, Dd) -> ?FUNCTION_NAME(Bin, 1+Dd, T1, RF, Enc, Str) end,
+ {"<<...>>", 7, 3, More};
+print_length(<<_/bitstring>> = Bin, D, T, RF, Enc, Str) ->
+ D1 = D - 1,
+ case
+ Str andalso
+ (bit_size(Bin) rem 8) =:= 0 andalso
+ printable_bin0(Bin, D1, tsub(T, 6), Enc)
+ of
+ {true, List} when is_list(List) ->
+ S = io_lib:write_string(List, $"), %"
+ {[$<,$<,S,$>,$>], 4 + length(S), 0, no_more};
+ {false, List} when is_list(List) ->
+ S = io_lib:write_string(List, $"), %"
+ {[$<,$<,S,"/utf8>>"], 9 + string:length(S), 0, no_more};
+ {true, true, Prefix} ->
+ S = io_lib:write_string(Prefix, $"), %"
+ More = fun(T1, Dd) ->
+ ?FUNCTION_NAME(Bin, D+Dd, T1, RF, Enc, Str)
+ end,
+ {[$<,$<,S|"...>>"], 7 + length(S), 3, More};
+ {false, true, Prefix} ->
+ S = io_lib:write_string(Prefix, $"), %"
+ More = fun(T1, Dd) ->
+ ?FUNCTION_NAME(Bin, D+Dd, T1, RF, Enc, Str)
+ end,
+ {[$<,$<,S|"/utf8...>>"], 12 + string:length(S), 3, More};
+ false ->
+ case io_lib:write_binary(Bin, D, T) of
+ {S, <<>>} ->
+ {{bin, S}, iolist_size(S), 0, no_more};
+ {S, _Rest} ->
+ More = fun(T1, Dd) ->
+ ?FUNCTION_NAME(Bin, D+Dd, T1, RF, Enc, Str)
+ end,
+ {{bin, S}, iolist_size(S), 3, More}
+ end
end;
-print_length(Term, _D, _RF, _Enc, _Str) ->
+print_length(Term, _D, _T, _RF, _Enc, _Str) ->
S = io_lib:write(Term),
%% S can contain unicode, so iolist_size(S) cannot be used here
- {S, string:length(S)}.
-
-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(erts_internal:maps_to_list(Map, D), D, RF, Enc, Str),
- {{map, Pairs}, list_length(Pairs, 3)}.
-
-print_length_map_pairs([], _D, _RF, _Enc, _Str) ->
+ {S, string:length(S), 0, no_more}.
+
+print_length_map(Map, 1, _T, RF, Enc, Str) ->
+ More = fun(T1, Dd) -> ?FUNCTION_NAME(Map, 1+Dd, T1, RF, Enc, Str) end,
+ {"#{...}", 6, 3, More};
+print_length_map(Map, D, T, RF, Enc, Str) when is_map(Map) ->
+ Next = maps:next(maps:iterator(Map)),
+ PairsS = print_length_map_pairs(Next, D, D - 1, tsub(T, 3), RF, Enc, Str),
+ {Len, Dots} = list_length(PairsS, 3, 0),
+ {{map, PairsS}, Len, Dots, no_more}.
+
+print_length_map_pairs(none, _D, _D0, _T, _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_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),
+print_length_map_pairs(Term, D, D0, T, RF, Enc, Str) when D =:= 1; T =:= 0->
+ More = fun(T1, Dd) ->
+ ?FUNCTION_NAME(Term, D+Dd, D0, T1, RF, Enc, Str)
+ end,
+ {dots, 3, 3, More};
+print_length_map_pairs({K, V, Iter}, D, D0, T, RF, Enc, Str) ->
+ Pair1 = print_length_map_pair(K, V, D0, tsub(T, 1), RF, Enc, Str),
+ {_, Len1, _, _} = Pair1,
+ Next = maps:next(Iter),
+ [Pair1 |
+ print_length_map_pairs(Next, D - 1, D0, tsub(T, Len1+1), RF, Enc, Str)].
+
+print_length_map_pair(K, V, D, T, RF, Enc, Str) ->
+ {_, KL, KD, _} = P1 = print_length(K, D, T, RF, Enc, Str),
KL1 = KL + 4,
- {{map_pair, {KS, KL1}, {VS, VL}}, KL1 + VL}.
-
-print_length_tuple(_Tuple, 1, _RF, _Enc, _Str) ->
- {"{...}", 5};
-print_length_tuple(Tuple, D, RF, Enc, Str) ->
- L = print_length_list1(tuple_to_list(Tuple), D, RF, Enc, Str),
+ {_, VL, VD, _} = P2 = print_length(V, D, tsub(T, KL1), RF, Enc, Str),
+ {{map_pair, P1, P2}, KL1 + VL, KD + VD, no_more}.
+
+print_length_tuple(Tuple, 1, _T, RF, Enc, Str) ->
+ More = fun(T1, Dd) -> ?FUNCTION_NAME(Tuple, 1+Dd, T1, RF, Enc, Str) end,
+ {"{...}", 5, 3, More};
+print_length_tuple(Tuple, D, T, RF, Enc, Str) ->
+ L = print_length_tuple1(Tuple, 1, D, tsub(T, 2), RF, Enc, Str),
IsTagged = is_atom(element(1, Tuple)) and (tuple_size(Tuple) > 1),
- {{tuple,IsTagged,L}, list_length(L, 2)}.
+ {Len, Dots} = list_length(L, 2, 0),
+ {{tuple,IsTagged,L}, Len, Dots, no_more}.
-print_length_record(_Tuple, 1, _RF, _RDefs, _Enc, _Str) ->
- {"{...}", 5};
-print_length_record(Tuple, D, RF, RDefs, Enc, Str) ->
+print_length_tuple1(Tuple, I, _D, _T, _RF, _Enc, _Str)
+ when I > tuple_size(Tuple) ->
+ [];
+print_length_tuple1(Tuple, I, D, T, RF, Enc, Str) when D =:= 1; T =:= 0->
+ More = fun(T1, Dd) -> ?FUNCTION_NAME(Tuple, I, D+Dd, T1, RF, Enc, Str) end,
+ {dots, 3, 3, More};
+print_length_tuple1(Tuple, I, D, T, RF, Enc, Str) ->
+ E = element(I, Tuple),
+ T1 = tsub(T, 1),
+ {_, Len1, _, _} = Elem1 = print_length(E, D - 1, T1, RF, Enc, Str),
+ T2 = tsub(T1, Len1),
+ [Elem1 | print_length_tuple1(Tuple, I + 1, D - 1, T2, RF, Enc, Str)].
+
+print_length_record(Tuple, 1, _T, RF, RDefs, Enc, Str) ->
+ More = fun(T1, Dd) ->
+ ?FUNCTION_NAME(Tuple, 1+Dd, T1, RF, RDefs, Enc, Str)
+ end,
+ {"{...}", 5, 3, More};
+print_length_record(Tuple, D, T, RF, RDefs, Enc, Str) ->
Name = [$# | write_atom(element(1, Tuple), Enc)],
- NameL = length(Name),
- Elements = tl(tuple_to_list(Tuple)),
- L = print_length_fields(RDefs, D - 1, Elements, RF, Enc, Str),
- {{record, [{Name,NameL} | L]}, list_length(L, NameL + 2)}.
-
-print_length_fields([], _D, [], _RF, _Enc, _Str) ->
+ NameL = string:length(Name),
+ T1 = tsub(T, NameL+2),
+ L = print_length_fields(RDefs, D - 1, T1, Tuple, 2, RF, Enc, Str),
+ {Len, Dots} = list_length(L, NameL + 2, 0),
+ {{record, [{Name,NameL} | L]}, Len, Dots, no_more}.
+
+print_length_fields([], _D, _T, Tuple, I, _RF, _Enc, _Str)
+ when I > tuple_size(Tuple) ->
[];
-print_length_fields(_, 1, _, _RF, _Enc, _Str) ->
- {dots, 3};
-print_length_fields([Def | Defs], D, [E | Es], RF, Enc, Str) ->
- [print_length_field(Def, D - 1, E, RF, Enc, Str) |
- print_length_fields(Defs, D - 1, Es, RF, Enc, Str)].
-
-print_length_field(Def, D, E, RF, Enc, Str) ->
+print_length_fields(Term, D, T, Tuple, I, RF, Enc, Str)
+ when D =:= 1; T =:= 0 ->
+ More = fun(T1, Dd) ->
+ ?FUNCTION_NAME(Term, D+Dd, T1, Tuple, I, RF, Enc, Str)
+ end,
+ {dots, 3, 3, More};
+print_length_fields([Def | Defs], D, T, Tuple, I, RF, Enc, Str) ->
+ E = element(I, Tuple),
+ T1 = tsub(T, 1),
+ Field1 = print_length_field(Def, D - 1, T1, E, RF, Enc, Str),
+ {_, Len1, _, _} = Field1,
+ T2 = tsub(T1, Len1),
+ [Field1 |
+ print_length_fields(Defs, D - 1, T2, Tuple, I + 1, RF, Enc, Str)].
+
+print_length_field(Def, D, T, E, RF, Enc, Str) ->
Name = write_atom(Def, Enc),
- {S, L} = print_length(E, D, RF, Enc, Str),
- NameL = length(Name) + 3,
- {{field, Name, NameL, {S, L}}, NameL + L}.
+ NameL = string:length(Name) + 3,
+ {_, Len, Dots, _} =
+ Field = print_length(E, D, tsub(T, NameL), RF, Enc, Str),
+ {{field, Name, NameL, Field}, NameL + Len, Dots, no_more}.
-print_length_list(List, D, RF, Enc, Str) ->
- L = print_length_list1(List, D, RF, Enc, Str),
- {{list, L}, list_length(L, 2)}.
+print_length_list(List, D, T, RF, Enc, Str) ->
+ L = print_length_list1(List, D, tsub(T, 2), RF, Enc, Str),
+ {Len, Dots} = list_length(L, 2, 0),
+ {{list, L}, Len, Dots, no_more}.
-print_length_list1([], _D, _RF, _Enc, _Str) ->
+print_length_list1([], _D, _T, _RF, _Enc, _Str) ->
[];
-print_length_list1(_, 1, _RF, _Enc, _Str) ->
- {dots, 3};
-print_length_list1([E | Es], D, RF, Enc, Str) ->
- [print_length(E, D - 1, RF, Enc, Str) |
- print_length_list1(Es, D - 1, RF, Enc, Str)];
-print_length_list1(E, D, RF, Enc, Str) ->
- print_length(E, D - 1, RF, Enc, Str).
-
-list_length([], Acc) ->
- Acc;
-list_length([{_, Len} | Es], Acc) ->
- list_length_tail(Es, Acc + Len);
-list_length({_, Len}, Acc) ->
- Acc + Len.
-
-list_length_tail([], Acc) ->
- Acc;
-list_length_tail([{_,Len} | Es], Acc) ->
- list_length_tail(Es, Acc + 1 + Len);
-list_length_tail({_, Len}, Acc) ->
- Acc + 1 + Len.
+print_length_list1(Term, D, T, RF, Enc, Str) when D =:= 1; T =:= 0->
+ More = fun(T1, Dd) -> ?FUNCTION_NAME(Term, D+Dd, T1, RF, Enc, Str) end,
+ {dots, 3, 3, More};
+print_length_list1([E | Es], D, T, RF, Enc, Str) ->
+ {_, Len1, _, _} = Elem1 = print_length(E, D - 1, tsub(T, 1), RF, Enc, Str),
+ [Elem1 | print_length_list1(Es, D - 1, tsub(T, Len1 + 1), RF, Enc, Str)];
+print_length_list1(E, D, T, RF, Enc, Str) ->
+ print_length(E, D - 1, T, RF, Enc, Str).
+
+list_length([], Acc, DotsAcc) ->
+ {Acc, DotsAcc};
+list_length([{_, Len, Dots, _} | Es], Acc, DotsAcc) ->
+ list_length_tail(Es, Acc + Len, DotsAcc + Dots);
+list_length({_, Len, Dots, _}, Acc, DotsAcc) ->
+ {Acc + Len, DotsAcc + Dots}.
+
+list_length_tail([], Acc, DotsAcc) ->
+ {Acc, DotsAcc};
+list_length_tail([{_, Len, Dots, _} | Es], Acc, DotsAcc) ->
+ list_length_tail(Es, Acc + 1 + Len, DotsAcc + Dots);
+list_length_tail({_, Len, Dots, _}, Acc, DotsAcc) ->
+ {Acc + 1 + Len, DotsAcc + Dots}.
%% ?CHARS printable characters has depth 1.
-define(CHARS, 4).
%% only flat lists are "printable"
-printable_list(_L, 1, _Enc) ->
+printable_list(_L, 1, _T, _Enc) ->
false;
-printable_list(L, _D, latin1) ->
+printable_list(L, _D, T, latin1) when T < 0 ->
io_lib:printable_latin1_list(L);
-printable_list(L, _D, _Uni) ->
+printable_list(L, _D, T, Enc) when T >= 0 ->
+ case slice(L, tsub(T, 2)) of
+ false ->
+ false;
+ {prefix, Prefix} when Enc =:= latin1 ->
+ io_lib:printable_latin1_list(Prefix) andalso {true, Prefix};
+ {prefix, Prefix} ->
+ %% Probably an overestimation.
+ io_lib:printable_list(Prefix) andalso {true, Prefix};
+ all when Enc =:= latin1 ->
+ io_lib:printable_latin1_list(L);
+ all ->
+ io_lib:printable_list(L)
+ end;
+printable_list(L, _D, T, _Uni) when T < 0->
io_lib:printable_list(L).
-printable_bin(Bin, D, Enc) when D >= 0, ?CHARS * D =< byte_size(Bin) ->
- printable_bin(Bin, erlang:min(?CHARS * D, byte_size(Bin)), D, Enc);
-printable_bin(Bin, D, Enc) ->
- printable_bin(Bin, byte_size(Bin), D, Enc).
+slice(L, N) ->
+ try string:length(L) =< N of
+ true ->
+ all;
+ false ->
+ case string:slice(L, 0, N) of
+ "" ->
+ false;
+ Prefix ->
+ {prefix, Prefix}
+ end
+ catch _:_ -> false
+ end.
+
+printable_bin0(Bin, D, T, Enc) ->
+ Len = case D >= 0 of
+ true ->
+ %% Use byte_size() also if Enc =/= latin1.
+ DChars = erlang:min(?CHARS * D, byte_size(Bin)),
+ case T >= 0 of
+ true ->
+ erlang:min(T, DChars);
+ false ->
+ DChars
+ end;
+ false when T < 0 ->
+ byte_size(Bin);
+ false when T >= 0 -> % cannot happen
+ T
+ end,
+ printable_bin(Bin, Len, D, Enc).
printable_bin(Bin, Len, D, latin1) ->
N = erlang:min(20, Len),
@@ -679,28 +879,70 @@ write_string(S, latin1) ->
write_string(S, _Uni) ->
io_lib:write_string(S, $"). %"
+expand({_, _, _Dots=0, no_more} = If, _T, _Dd) -> If;
+%% expand({{list,L}, _Len, _, no_more}, T, Dd) ->
+%% {NL, NLen, NDots} = expand_list(L, T, Dd, 2),
+%% {{list,NL}, NLen, NDots, no_more};
+expand({{tuple,IsTagged,L}, _Len, _, no_more}, T, Dd) ->
+ {NL, NLen, NDots} = expand_list(L, T, Dd, 2),
+ {{tuple,IsTagged,NL}, NLen, NDots, no_more};
+expand({{map, Pairs}, _Len, _, no_more}, T, Dd) ->
+ {NPairs, NLen, NDots} = expand_list(Pairs, T, Dd, 3),
+ {{map, NPairs}, NLen, NDots, no_more};
+expand({{map_pair, K, V}, _Len, _, no_more}, T, Dd) ->
+ {_, KL, KD, _} = P1 = expand(K, tsub(T, 1), Dd),
+ KL1 = KL + 4,
+ {_, VL, VD, _} = P2 = expand(V, tsub(T, KL1), Dd),
+ {{map_pair, P1, P2}, KL1 + VL, KD + VD, no_more};
+expand({{record, [{Name,NameL} | L]}, _Len, _, no_more}, T, Dd) ->
+ {NL, NLen, NDots} = expand_list(L, T, Dd, NameL + 2),
+ {{record, [{Name,NameL} | NL]}, NLen, NDots, no_more};
+expand({{field, Name, NameL, Field}, _Len, _, no_more}, T, Dd) ->
+ F = {_S, L, Dots, _} = expand(Field, tsub(T, NameL), Dd),
+ {{field, Name, NameL, F}, NameL + L, Dots, no_more};
+expand({_, _, _, More}, T, Dd) ->
+ More(T, Dd).
+
+expand_list(Ifs, T, Dd, L0) ->
+ L = expand_list(Ifs, tsub(T, L0), Dd),
+ {Len, Dots} = list_length(L, L0, 0),
+ {L, Len, Dots}.
+
+expand_list([], _T, _Dd) ->
+ [];
+expand_list([If | Ifs], T, Dd) ->
+ {_, Len1, _, _} = Elem1 = expand(If, tsub(T, 1), Dd),
+ [Elem1 | expand_list(Ifs, tsub(T, Len1 + 1), Dd)];
+expand_list({_, _, _, More}, T, Dd) ->
+ More(T, Dd).
+
+%% Make sure T does not change sign.
+tsub(T, _) when T < 0 -> T;
+tsub(T, E) when T >= E -> T - E;
+tsub(_, _) -> 0.
+
%% Throw 'no_good' if the indentation exceeds half the line length
%% unless there is room for M characters on the line.
-cind({_S, Len}, Col, Ll, M, Ind, LD, W) when Len < Ll - Col - LD,
- Len + W + LD =< M ->
+cind({_S, Len, _, _}, Col, Ll, M, Ind, LD, W) when Len < Ll - Col - LD,
+ Len + W + LD =< M ->
Ind;
-cind({{list,L}, _Len}, Col, Ll, M, Ind, LD, W) ->
+cind({{list,L}, _Len, _, _}, Col, Ll, M, Ind, LD, W) ->
cind_list(L, Col + 1, Ll, M, Ind, LD, W + 1);
-cind({{tuple,true,L}, _Len}, Col, Ll, M, Ind, LD, W) ->
+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({{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}, _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,[{_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) ->
+cind({{bin,_S}, _Len, _, _}, _Col, _Ll, _M, Ind, _LD, _W) ->
Ind;
-cind({_S, _Len}, _Col, _Ll, _M, Ind, _LD, _W) ->
+cind({_S,_Len,_,_}, _Col, _Ll, _M, Ind, _LD, _W) ->
Ind.
-cind_tag_tuple([{_Tag,Tlen} | L], Col, Ll, M, Ind, LD, W) ->
+cind_tag_tuple([{_Tag,Tlen,_,_} | L], Col, Ll, M, Ind, LD, W) ->
TagInd = Tlen + 2,
Tcol = Col + TagInd,
if
@@ -722,9 +964,9 @@ 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.
+ Ind. % cannot happen
-cind_pairs_tail([{_, Len}=P | Ps], Col0, Col, Ll, M, Ind, LD, W) ->
+cind_pairs_tail([{_, Len, _, _} = P | Ps], Col0, Col, Ll, M, Ind, LD, W) ->
LD1 = last_depth(Ps, LD),
ELen = 1 + Len,
if
@@ -738,7 +980,7 @@ cind_pairs_tail([{_, Len}=P | Ps], Col0, Col, Ll, M, Ind, LD, W) ->
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)
+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) ->
@@ -746,7 +988,7 @@ cind_pair({{map_pair, _Key, _Value}, Len}=Pair, Col, Ll, M, _Ind, LD, W)
true ->
Ll
end;
-cind_pair({{map_pair, K, V}, _Len}, Col0, Ll, M, Ind, LD, W0) ->
+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),
@@ -768,7 +1010,7 @@ cind_record([F | Fs], Nlen, Col0, Ll, M, Ind, LD, W0) ->
cind_record(_, _Nlen, _Col, _Ll, _M, Ind, _LD, _W) ->
Ind.
-cind_fields_tail([{_, Len}=F | Fs], Col0, Col, Ll, M, Ind, LD, W) ->
+cind_fields_tail([{_, Len, _, _} = F | Fs], Col0, Col, Ll, M, Ind, LD, W) ->
LD1 = last_depth(Fs, LD),
ELen = 1 + Len,
if
@@ -782,7 +1024,7 @@ cind_fields_tail([{_, Len}=F | Fs], Col0, Col, Ll, M, Ind, LD, W) ->
cind_fields_tail(_, _Col0, _Col, _Ll, _M, Ind, _LD, _W) ->
Ind.
-cind_field({{field, _N, _NL, _F}, Len}=Fl, Col, Ll, M, _Ind, LD, W)
+cind_field({{field, _N, _NL, _F}, Len, _, _}=Fl, Col, Ll, M, _Ind, LD, W)
when Len < Ll - Col - LD, Len + W + LD =< M ->
if
?ATM_FLD(Fl) ->
@@ -790,7 +1032,7 @@ cind_field({{field, _N, _NL, _F}, Len}=Fl, Col, Ll, M, _Ind, LD, W)
true ->
Ll
end;
-cind_field({{field, _Name, NameL, F}, _Len}, Col0, Ll, M, Ind, LD, W0) ->
+cind_field({{field, _Name, NameL, F},_Len,_,_}, Col0, Ll, M, Ind, LD, W0) ->
{Col, W} = cind_rec(NameL, Col0, Ll, M, Ind, W0 + NameL),
cind(F, Col, Ll, M, Ind, LD, W),
Ll.
@@ -813,7 +1055,7 @@ cind_rec(RInd, Col0, Ll, M, Ind, W0) ->
throw(no_good)
end.
-cind_list({dots, _}, _Col0, _Ll, _M, Ind, _LD, _W) ->
+cind_list({dots, _, _, _}, _Col0, _Ll, _M, Ind, _LD, _W) ->
Ind;
cind_list([E | Es], Col0, Ll, M, Ind, LD, W) ->
WE = cind_element(E, Col0, Ll, M, Ind, last_depth(Es, LD), W),
@@ -821,7 +1063,7 @@ cind_list([E | Es], Col0, Ll, M, Ind, LD, W) ->
cind_tail([], _Col0, _Col, _Ll, _M, Ind, _LD, _W) ->
Ind;
-cind_tail([{_, Len}=E | Es], Col0, Col, Ll, M, Ind, LD, W) ->
+cind_tail([{_, Len, _, _} = E | Es], Col0, Col, Ll, M, Ind, LD, W) ->
LD1 = last_depth(Es, LD),
ELen = 1 + Len,
if
@@ -832,9 +1074,9 @@ cind_tail([{_, Len}=E | Es], Col0, Col, Ll, M, Ind, LD, W) ->
WE = cind_element(E, Col0, Ll, M, Ind, LD1, 0),
cind_tail(Es, Col0, Col0 + WE, Ll, M, Ind, LD, WE)
end;
-cind_tail({dots, _}, _Col0, _Col, _Ll, _M, Ind, _LD, _W) ->
+cind_tail({dots, _, _, _}, _Col0, _Col, _Ll, _M, Ind, _LD, _W) ->
Ind;
-cind_tail({_, Len}=E, _Col0, Col, Ll, M, Ind, LD, W)
+cind_tail({_, Len, _, _}=E, _Col0, Col, Ll, M, Ind, LD, W)
when Len + 1 < Ll - Col - (LD + 1),
Len + 1 + W + (LD + 1) =< M,
?ATM(E) ->
@@ -842,7 +1084,7 @@ cind_tail({_, Len}=E, _Col0, Col, Ll, M, Ind, LD, W)
cind_tail(E, _Col0, Col, Ll, M, Ind, LD, _W) ->
cind(E, Col, Ll, M, Ind, LD + 1, 0).
-cind_element({_, Len}=E, Col, Ll, M, _Ind, LD, W)
+cind_element({_, Len, _, _}=E, Col, Ll, M, _Ind, LD, W)
when Len < Ll - Col - LD, Len + W + LD =< M, ?ATM(E) ->
Len;
cind_element(E, Col, Ll, M, Ind, LD, W) ->
diff --git a/lib/stdlib/src/lists.erl b/lib/stdlib/src/lists.erl
index af9d63ddd6..06c90c0280 100644
--- a/lib/stdlib/src/lists.erl
+++ b/lib/stdlib/src/lists.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -38,8 +38,8 @@
-export([all/2,any/2,map/2,flatmap/2,foldl/3,foldr/3,filter/2,
partition/2,zf/2,filtermap/2,
- mapfoldl/3,mapfoldr/3,foreach/2,takewhile/2,dropwhile/2,splitwith/2,
- split/2,
+ mapfoldl/3,mapfoldr/3,foreach/2,takewhile/2,dropwhile/2,
+ search/2, splitwith/2,split/2,
join/2]).
%%% BIFs
@@ -1399,6 +1399,19 @@ dropwhile(Pred, [Hd|Tail]=Rest) ->
end;
dropwhile(Pred, []) when is_function(Pred, 1) -> [].
+-spec search(Pred, List) -> {value, Value} | false when
+ Pred :: fun((T) -> boolean()),
+ List :: [T],
+ Value :: T.
+
+search(Pred, [Hd|Tail]) ->
+ case Pred(Hd) of
+ true -> {value, Hd};
+ false -> search(Pred, Tail)
+ end;
+search(Pred, []) when is_function(Pred, 1) ->
+ false.
+
-spec splitwith(Pred, List) -> {List1, List2} when
Pred :: fun((T) -> boolean()),
List :: [T],
diff --git a/lib/stdlib/src/maps.erl b/lib/stdlib/src/maps.erl
index 5dafdb282a..60463feec2 100644
--- a/lib/stdlib/src/maps.erl
+++ b/lib/stdlib/src/maps.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2013-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2013-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -23,7 +23,8 @@
-export([get/3, filter/2,fold/3,
map/2, size/1,
update_with/3, update_with/4,
- without/2, with/2]).
+ without/2, with/2,
+ iterator/1, next/1]).
%% BIFs
-export([get/2, find/2, from_list/1,
@@ -31,6 +32,15 @@
new/0, put/3, remove/2, take/2,
to_list/1, update/3, values/1]).
+-opaque iterator() :: {term(), term(), iterator()}
+ | none | nonempty_improper_list(integer(),map()).
+
+-export_type([iterator/0]).
+
+-dialyzer({no_improper_lists, iterator/1}).
+
+-define(IS_ITERATOR(I), is_tuple(I) andalso tuple_size(I) == 3; I == none; is_integer(hd(I)) andalso is_map(tl(I))).
+
%% Shadowed by erl_bif_types: maps:get/2
-spec get(Key,Map) -> Value when
Key :: term(),
@@ -39,7 +49,6 @@
get(_,_) -> erlang:nif_error(undef).
-
-spec find(Key,Map) -> {ok, Value} | error when
Key :: term(),
Map :: map(),
@@ -114,14 +123,20 @@ remove(_,_) -> erlang:nif_error(undef).
take(_,_) -> erlang:nif_error(undef).
-%% Shadowed by erl_bif_types: maps:to_list/1
-spec to_list(Map) -> [{Key,Value}] when
Map :: map(),
Key :: term(),
Value :: term().
-to_list(_) -> erlang:nif_error(undef).
+to_list(Map) when is_map(Map) ->
+ to_list_internal(erts_internal:map_next(0, Map, []));
+to_list(Map) ->
+ erlang:error({badmap,Map},[Map]).
+to_list_internal([Iter, Map | Acc]) when is_integer(Iter) ->
+ to_list_internal(erts_internal:map_next(Iter, Map, Acc));
+to_list_internal(Acc) ->
+ Acc.
%% Shadowed by erl_bif_types: maps:update/3
-spec update(Key,Value,Map1) -> Map2 when
@@ -192,47 +207,80 @@ get(Key,Map,Default) ->
erlang:error({badmap,Map},[Key,Map,Default]).
--spec filter(Pred,Map1) -> Map2 when
+-spec filter(Pred,MapOrIter) -> Map when
Pred :: fun((Key, Value) -> boolean()),
Key :: term(),
Value :: term(),
- Map1 :: map(),
- Map2 :: map().
+ MapOrIter :: map() | iterator(),
+ Map :: map().
filter(Pred,Map) when is_function(Pred,2), is_map(Map) ->
- maps:from_list([{K,V}||{K,V}<-maps:to_list(Map),Pred(K,V)]);
+ maps:from_list(filter_1(Pred, iterator(Map)));
+filter(Pred,Iterator) when is_function(Pred,2), ?IS_ITERATOR(Iterator) ->
+ maps:from_list(filter_1(Pred, Iterator));
filter(Pred,Map) ->
erlang:error(error_type(Map),[Pred,Map]).
-
--spec fold(Fun,Init,Map) -> Acc when
+filter_1(Pred, Iter) ->
+ case next(Iter) of
+ {K, V, NextIter} ->
+ case Pred(K,V) of
+ true ->
+ [{K,V} | filter_1(Pred, NextIter)];
+ false ->
+ filter_1(Pred, NextIter)
+ end;
+ none ->
+ []
+ end.
+
+-spec fold(Fun,Init,MapOrIter) -> Acc when
Fun :: fun((K, V, AccIn) -> AccOut),
Init :: term(),
Acc :: term(),
AccIn :: term(),
AccOut :: term(),
- Map :: map(),
+ MapOrIter :: map() | iterator(),
K :: term(),
V :: term().
fold(Fun,Init,Map) when is_function(Fun,3), is_map(Map) ->
- lists:foldl(fun({K,V},A) -> Fun(K,V,A) end,Init,maps:to_list(Map));
+ fold_1(Fun,Init,iterator(Map));
+fold(Fun,Init,Iterator) when is_function(Fun,3), ?IS_ITERATOR(Iterator) ->
+ fold_1(Fun,Init,Iterator);
fold(Fun,Init,Map) ->
- erlang:error(error_type(Map),[Fun,Init,Map]).
+ erlang:error(error_type_iter(Map),[Fun,Init,Map]).
+
+fold_1(Fun, Acc, Iter) ->
+ case next(Iter) of
+ {K, V, NextIter} ->
+ fold_1(Fun, Fun(K,V,Acc), NextIter);
+ none ->
+ Acc
+ end.
--spec map(Fun,Map1) -> Map2 when
+-spec map(Fun,MapOrIter) -> Map when
Fun :: fun((K, V1) -> V2),
- Map1 :: map(),
- Map2 :: map(),
+ MapOrIter :: map() | iterator(),
+ Map :: map(),
K :: term(),
V1 :: term(),
V2 :: term().
map(Fun,Map) when is_function(Fun, 2), is_map(Map) ->
- maps:from_list([{K,Fun(K,V)}||{K,V}<-maps:to_list(Map)]);
+ maps:from_list(map_1(Fun, iterator(Map)));
+map(Fun,Iterator) when is_function(Fun, 2), ?IS_ITERATOR(Iterator) ->
+ maps:from_list(map_1(Fun, Iterator));
map(Fun,Map) ->
- erlang:error(error_type(Map),[Fun,Map]).
+ erlang:error(error_type_iter(Map),[Fun,Map]).
+map_1(Fun, Iter) ->
+ case next(Iter) of
+ {K, V, NextIter} ->
+ [{K, Fun(K, V)} | map_1(Fun, NextIter)];
+ none ->
+ []
+ end.
-spec size(Map) -> non_neg_integer() when
Map :: map().
@@ -242,6 +290,26 @@ size(Map) when is_map(Map) ->
size(Val) ->
erlang:error({badmap,Val},[Val]).
+-spec iterator(Map) -> Iterator when
+ Map :: map(),
+ Iterator :: iterator().
+
+iterator(M) when is_map(M) -> [0 | M];
+iterator(M) -> erlang:error({badmap, M}, [M]).
+
+-spec next(Iterator) -> {Key, Value, NextIterator} | 'none' when
+ Iterator :: iterator(),
+ Key :: term(),
+ Value :: term(),
+ NextIterator :: iterator().
+next({K, V, I}) ->
+ {K, V, I};
+next([Path | Map]) when is_integer(Path), is_map(Map) ->
+ erts_internal:map_next(Path, Map, iterator);
+next(none) ->
+ none;
+next(Iter) ->
+ erlang:error(badarg, [Iter]).
-spec without(Ks,Map1) -> Map2 when
Ks :: [K],
@@ -250,11 +318,10 @@ size(Val) ->
K :: term().
without(Ks,M) when is_list(Ks), is_map(M) ->
- lists:foldl(fun(K, M1) -> ?MODULE:remove(K, M1) end, M, Ks);
+ lists:foldl(fun(K, M1) -> maps:remove(K, M1) end, M, Ks);
without(Ks,M) ->
erlang:error(error_type(M),[Ks,M]).
-
-spec with(Ks, Map1) -> Map2 when
Ks :: [K],
Map1 :: map(),
@@ -263,17 +330,20 @@ without(Ks,M) ->
with(Ks,Map1) when is_list(Ks), is_map(Map1) ->
Fun = fun(K, List) ->
- case ?MODULE:find(K, Map1) of
- {ok, V} ->
- [{K, V} | List];
- error ->
- List
- end
- end,
- ?MODULE:from_list(lists:foldl(Fun, [], Ks));
+ case maps:find(K, Map1) of
+ {ok, V} ->
+ [{K, V} | List];
+ error ->
+ List
+ end
+ end,
+ maps:from_list(lists:foldl(Fun, [], Ks));
with(Ks,M) ->
erlang:error(error_type(M),[Ks,M]).
error_type(M) when is_map(M) -> badarg;
error_type(V) -> {badmap, V}.
+
+error_type_iter(M) when is_map(M); ?IS_ITERATOR(M) -> badarg;
+error_type_iter(V) -> {badmap, V}.
diff --git a/lib/stdlib/src/ms_transform.erl b/lib/stdlib/src/ms_transform.erl
index 6616e957c0..6d243e1bec 100644
--- a/lib/stdlib/src/ms_transform.erl
+++ b/lib/stdlib/src/ms_transform.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2002-2017. All Rights Reserved.
+%% Copyright Ericsson AB 2002-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -224,10 +224,12 @@ transform_from_shell(Dialect, Clauses, BoundEnvironment) ->
%% Called when translating during compiling
%%
--spec parse_transform(Forms, Options) -> Forms2 when
+-spec parse_transform(Forms, Options) -> Forms2 | Errors | Warnings when
Forms :: [erl_parse:abstract_form() | erl_parse:form_info()],
Forms2 :: [erl_parse:abstract_form() | erl_parse:form_info()],
- Options :: term().
+ Options :: term(),
+ Errors :: {error, ErrInfo :: [tuple()], WarnInfo :: []},
+ Warnings :: {warning, Forms2, WarnInfo :: [tuple()]}.
parse_transform(Forms, _Options) ->
SaveFilename = setup_filename(),
@@ -929,6 +931,7 @@ bool_test(is_port,1) -> true;
bool_test(is_reference,1) -> true;
bool_test(is_tuple,1) -> true;
bool_test(is_map,1) -> true;
+bool_test(is_map_key, 2) -> true;
bool_test(is_binary,1) -> true;
bool_test(is_function,1) -> true;
bool_test(is_record,2) -> true;
@@ -943,7 +946,9 @@ real_guard_function(node,0) -> true;
real_guard_function(node,1) -> true;
real_guard_function(round,1) -> true;
real_guard_function(size,1) -> true;
+real_guard_function(bit_size,1) -> true;
real_guard_function(map_size,1) -> true;
+real_guard_function(map_get,2) -> true;
real_guard_function(tl,1) -> true;
real_guard_function(trunc,1) -> true;
real_guard_function(self,0) -> true;
@@ -1115,5 +1120,3 @@ normalise_list([H|T]) ->
[normalise(H)|normalise_list(T)];
normalise_list([]) ->
[].
-
-
diff --git a/lib/stdlib/src/ordsets.erl b/lib/stdlib/src/ordsets.erl
index 569407f5ef..176047079b 100644
--- a/lib/stdlib/src/ordsets.erl
+++ b/lib/stdlib/src/ordsets.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -19,7 +19,7 @@
-module(ordsets).
--export([new/0,is_set/1,size/1,to_list/1,from_list/1]).
+-export([new/0,is_set/1,size/1,is_empty/1,to_list/1,from_list/1]).
-export([is_element/2,add_element/2,del_element/2]).
-export([union/2,union/1,intersection/2,intersection/1]).
-export([is_disjoint/2]).
@@ -60,6 +60,13 @@ is_set([], _) -> true.
size(S) -> length(S).
+%% is_empty(OrdSet) -> boolean().
+%% Return 'true' if OrdSet is an empty set, otherwise 'false'.
+-spec is_empty(Ordset) -> boolean() when
+ Ordset :: ordset(_).
+
+is_empty(S) -> S=:=[].
+
%% to_list(OrdSet) -> [Elem].
%% Return the elements in OrdSet as a list.
diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl
index 5b488cc677..aaed13ba3a 100644
--- a/lib/stdlib/src/otp_internal.erl
+++ b/lib/stdlib/src/otp_internal.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -604,11 +604,25 @@ obsolete_1(filename, find_src, 1) ->
obsolete_1(filename, find_src, 2) ->
{deprecated, "deprecated; use filelib:find_source/3 instead"};
+obsolete_1(erlang, get_stacktrace, 0) ->
+ {deprecated, "deprecated; use the new try/catch syntax for retrieving the stack backtrace"};
+
%% Removed in OTP 20.
obsolete_1(erlang, hash, 2) ->
{removed, {erlang, phash2, 2}, "20.0"};
+%% Add in OTP 21.
+
+obsolete_1(ssl, ssl_accept, 1) ->
+ {deprecated, "deprecated; use ssl:handshake/1 instead"};
+obsolete_1(ssl, ssl_accept, 2) ->
+ {deprecated, "deprecated; use ssl:handshake/2 instead"};
+obsolete_1(ssl, ssl_accept, 3) ->
+ {deprecated, "deprecated; use ssl:handshake/3 instead"};
+obsolete_1(otp_mib, F, _) when F =:= load; F =:= unload ->
+ {deprecated, "deprecated; functionality will be removed in a future release"};
+
%% not obsolete
obsolete_1(_, _, _) ->
diff --git a/lib/stdlib/src/pool.erl b/lib/stdlib/src/pool.erl
index 05950a1d7c..599be55607 100644
--- a/lib/stdlib/src/pool.erl
+++ b/lib/stdlib/src/pool.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -25,7 +25,7 @@
%% with the least load !!!!
%% This function is callable from any node including the master
%% That is part of the pool
-%% nodes are scheduled on a per usgae basis and per load basis,
+%% nodes are scheduled on a per usage basis and per load basis,
%% Whenever we use a node, we put at the end of the queue, and whenever
%% a node report a change in load, we insert it accordingly
@@ -197,7 +197,7 @@ pure_insert({Load,Node},[{L,N}|Tail]) when Load < L ->
pure_insert(L,[H|T]) -> [H|pure_insert(L,T)].
%% Really should not measure the contributions from
-%% the back ground processes here .... which we do :-(
+%% the background processes here .... which we do :-(
%% We don't have to monitor the master, since we're slaves anyway
statistic_collector() ->
@@ -213,7 +213,7 @@ statistic_collector(I) ->
stat_loop(M, 999999)
end.
-%% Do not tell the master about our load if it has not changed
+%% Do not tell the master about our load if it has not changed
stat_loop(M, Old) ->
sleep(2000),
diff --git a/lib/stdlib/src/proc_lib.erl b/lib/stdlib/src/proc_lib.erl
index 8e10cbe93b..cfbaf8b242 100644
--- a/lib/stdlib/src/proc_lib.erl
+++ b/lib/stdlib/src/proc_lib.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -30,7 +30,7 @@
start/3, start/4, start/5, start_link/3, start_link/4, start_link/5,
hibernate/3,
init_ack/1, init_ack/2,
- init_p/3,init_p/5,format/1,format/2,format/3,
+ init_p/3,init_p/5,format/1,format/2,format/3,report_cb/2,
initial_call/1,
translate_initial_call/1,
stop/1, stop/3]).
@@ -40,6 +40,8 @@
-export_type([spawn_option/0]).
+-include("logger.hrl").
+
%%-----------------------------------------------------------------------------
-type priority_level() :: 'high' | 'low' | 'max' | 'normal'.
@@ -231,8 +233,8 @@ init_p(Parent, Ancestors, Fun) when is_function(Fun) ->
try
Fun()
catch
- Class:Reason ->
- exit_p(Class, Reason, erlang:get_stacktrace())
+ Class:Reason:Stacktrace ->
+ exit_p(Class, Reason, Stacktrace)
end.
-spec init_p(pid(), [pid()], atom(), atom(), [term()]) -> term().
@@ -246,8 +248,8 @@ init_p_do_apply(M, F, A) ->
try
apply(M, F, A)
catch
- Class:Reason ->
- exit_p(Class, Reason, erlang:get_stacktrace())
+ Class:Reason:Stacktrace ->
+ exit_p(Class, Reason, Stacktrace)
end.
-spec wake_up(atom(), atom(), [term()]) -> term().
@@ -256,8 +258,8 @@ wake_up(M, F, A) when is_atom(M), is_atom(F), is_list(A) ->
try
apply(M, F, A)
catch
- Class:Reason ->
- exit_p(Class, Reason, erlang:get_stacktrace())
+ Class:Reason:Stacktrace ->
+ exit_p(Class, Reason, Stacktrace)
end.
exit_p(Class, Reason, Stacktrace) ->
@@ -503,10 +505,13 @@ crash_report(exit, normal, _, _) -> ok;
crash_report(exit, shutdown, _, _) -> ok;
crash_report(exit, {shutdown,_}, _, _) -> ok;
crash_report(Class, Reason, StartF, Stacktrace) ->
- OwnReport = my_info(Class, Reason, StartF, Stacktrace),
- LinkReport = linked_info(self()),
- Rep = [OwnReport,LinkReport],
- error_logger:error_report(crash_report, Rep).
+ ?LOG_ERROR(#{label=>{proc_lib,crash},
+ report=>[my_info(Class, Reason, StartF, Stacktrace),
+ linked_info(self())]},
+ #{domain=>[otp,sasl],
+ report_cb=>fun proc_lib:report_cb/2,
+ logger_formatter=>#{title=>"CRASH REPORT"},
+ error_logger=>#{tag=>error_report,type=>crash_report}}).
my_info(Class, Reason, [], Stacktrace) ->
my_info_1(Class, Reason, Stacktrace);
@@ -742,9 +747,20 @@ check({badrpc,Error}) -> Error;
check(Res) -> Res.
%%% -----------------------------------------------------------
-%%% Format (and write) a generated crash info structure.
+%%% Format a generated crash info structure.
%%% -----------------------------------------------------------
+-spec report_cb(CrashReport,FormatOpts) -> unicode:chardata() when
+ CrashReport :: #{label => {proc_lib,crash},
+ report => [term()]},
+ FormatOpts :: logger:report_cb_config().
+report_cb(#{label:={proc_lib,crash}, report:=CrashReport}, Extra) ->
+ Default = #{chars_limit => unlimited,
+ depth => unlimited,
+ single_line => false,
+ encoding => utf8},
+ do_format(CrashReport, maps:merge(Default,Extra)).
+
-spec format(CrashReport) -> string() when
CrashReport :: [term()].
format(CrashReport) ->
@@ -762,32 +778,51 @@ format(CrashReport, Encoding) ->
Encoding :: latin1 | unicode | utf8,
Depth :: unlimited | pos_integer().
-format([OwnReport,LinkReport], Encoding, Depth) ->
- Extra = {Encoding,Depth},
- MyIndent = " ",
+format(CrashReport, Encoding, Depth) ->
+ do_format(CrashReport, #{chars_limit => unlimited,
+ depth => Depth,
+ encoding => Encoding,
+ single_line => false}).
+
+do_format([OwnReport,LinkReport], #{single_line:=Single}=Extra) ->
+ Indent = if Single -> "";
+ true -> " "
+ end,
+ MyIndent = Indent ++ Indent,
+ Sep = nl(Single,"; "),
OwnFormat = format_report(OwnReport, MyIndent, Extra),
- LinkFormat = format_link_report(LinkReport, MyIndent, Extra),
- Str = io_lib:format(" crasher:~n~ts neighbours:~n~ts",
- [OwnFormat, LinkFormat]),
+ LinkFormat = lists:join(Sep,format_link_report(LinkReport, MyIndent, Extra)),
+ Nl = nl(Single," "),
+ Str = io_lib:format("~scrasher:"++Nl++"~ts"++Sep++"~sneighbours:"++Nl++"~ts",
+ [Indent,OwnFormat,Indent,LinkFormat]),
lists:flatten(Str).
-format_link_report([Link|Reps], Indent, Extra) ->
+format_link_report([Link|Reps], Indent0, #{single_line:=Single}=Extra) ->
Rep = case Link of
{neighbour,Rep0} -> Rep0;
_ -> Link
end,
+ Indent = if Single -> "";
+ true -> Indent0
+ end,
LinkIndent = [" ",Indent],
- [Indent,"neighbour:\n",format_report(Rep, LinkIndent, Extra)|
+ [[Indent,"neighbour:",nl(Single," "),format_report(Rep, LinkIndent, Extra)]|
format_link_report(Reps, Indent, Extra)];
format_link_report(Rep, Indent, Extra) ->
format_report(Rep, Indent, Extra).
-format_report(Rep, Indent, Extra) when is_list(Rep) ->
- format_rep(Rep, Indent, Extra);
-format_report(Rep, Indent, {Enc,unlimited}) ->
- io_lib:format("~s~"++modifier(Enc)++"p~n", [Indent, Rep]);
-format_report(Rep, Indent, {Enc,Depth}) ->
- io_lib:format("~s~"++modifier(Enc)++"P~n", [Indent, Rep, Depth]).
+format_report(Rep, Indent, #{single_line:=Single}=Extra) when is_list(Rep) ->
+ lists:join(nl(Single,", "),format_rep(Rep, Indent, Extra));
+format_report(Rep, Indent0, #{encoding:=Enc,depth:=Depth,
+ chars_limit:=Limit,single_line:=Single}) ->
+ {P,Tl} = p(Enc,Depth),
+ {Indent,Width} = if Single -> {"","0"};
+ true -> {Indent0,""}
+ end,
+ Opts = if is_integer(Limit) -> [{chars_limit,Limit}];
+ true -> []
+ end,
+ io_lib:format("~s~"++Width++P, [Indent, Rep | Tl], Opts).
format_rep([{initial_call,InitialCall}|Rep], Indent, Extra) ->
[format_mfa(Indent, InitialCall, Extra)|format_rep(Rep, Indent, Extra)];
@@ -799,19 +834,32 @@ format_rep([{Tag,Data}|Rep], Indent, Extra) ->
format_rep(_, _, _Extra) ->
[].
-format_exception(Class, Reason, StackTrace, {Enc,_}=Extra) ->
+format_exception(Class, Reason, StackTrace,
+ #{encoding:=Enc,depth:=Depth,chars_limit:=Limit,
+ single_line:=Single}=Extra) ->
PF = pp_fun(Extra),
StackFun = fun(M, _F, _A) -> (M =:= erl_eval) or (M =:= ?MODULE) end,
- %% EI = " exception: ",
- EI = " ",
- [EI, lib:format_exception(1+length(EI), Class, Reason,
- StackTrace, StackFun, PF, Enc), "\n"].
+ if Single ->
+ {P,Tl} = p(Enc,Depth),
+ Opts = if is_integer(Limit) -> [{chars_limit,Limit}];
+ true -> []
+ end,
+ [atom_to_list(Class), ": ",
+ io_lib:format("~0"++P,[{Reason,StackTrace}|Tl],Opts)];
+ true ->
+ EI = " ",
+ [EI, erl_error:format_exception(1+length(EI), Class, Reason,
+ StackTrace, StackFun, PF, Enc)]
+ end.
-format_mfa(Indent, {M,F,Args}=StartF, {Enc,_}=Extra) ->
+format_mfa(Indent0, {M,F,Args}=StartF, #{encoding:=Enc,single_line:=Single}=Extra) ->
+ Indent = if Single -> "";
+ true -> Indent0
+ end,
try
A = length(Args),
[Indent,"initial call: ",atom_to_list(M),$:,to_string(F, Enc),$/,
- integer_to_list(A),"\n"]
+ integer_to_list(A)]
catch
error:_ ->
format_tag(Indent, initial_call, StartF, Extra)
@@ -822,15 +870,29 @@ to_string(A, latin1) ->
to_string(A, _) ->
io_lib:write_atom(A).
-pp_fun({Enc,Depth}) ->
+pp_fun(#{encoding:=Enc,depth:=Depth,chars_limit:=Limit,single_line:=Single}) ->
{P,Tl} = p(Enc, Depth),
+ Width = if Single -> "0";
+ true -> ""
+ end,
+ Opts = if is_integer(Limit) -> [{chars_limit,Limit}];
+ true -> []
+ end,
fun(Term, I) ->
- io_lib:format("~." ++ integer_to_list(I) ++ P, [Term|Tl])
+ io_lib:format("~" ++ Width ++ "." ++ integer_to_list(I) ++ P,
+ [Term|Tl], Opts)
end.
-format_tag(Indent, Tag, Data, {Enc,Depth}) ->
+format_tag(Indent0, Tag, Data, #{encoding:=Enc,depth:=Depth,chars_limit:=Limit,single_line:=Single}) ->
{P,Tl} = p(Enc, Depth),
- io_lib:format("~s~p: ~80.18" ++ P ++ "\n", [Indent, Tag, Data|Tl]).
+ {Indent,Width} = if Single -> {"","0"};
+ true -> {Indent0,""}
+ end,
+ Opts = if is_integer(Limit) -> [{chars_limit,Limit}];
+ true -> []
+ end,
+ io_lib:format("~s~" ++ Width ++ "p: ~" ++ Width ++ ".18" ++ P,
+ [Indent, Tag, Data|Tl], Opts).
p(Encoding, Depth) ->
{Letter, Tl} = case Depth of
@@ -843,6 +905,8 @@ p(Encoding, Depth) ->
modifier(latin1) -> "";
modifier(_) -> "t".
+nl(true,Else) -> Else;
+nl(false,_) -> "\n".
%%% -----------------------------------------------------------
%%% Stop a process and wait for it to terminate
diff --git a/lib/stdlib/src/qlc.erl b/lib/stdlib/src/qlc.erl
index f11f9d0a0b..a1c1117e31 100644
--- a/lib/stdlib/src/qlc.erl
+++ b/lib/stdlib/src/qlc.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2017. All Rights Reserved.
+%% Copyright Ericsson AB 2004-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -301,11 +301,11 @@ eval(QH, Options) ->
post_funs(Post)
end
end
- catch Term ->
- case erlang:get_stacktrace() of
+ catch throw:Term:Stacktrace ->
+ case Stacktrace of
[?THROWN_ERROR | _] ->
Term;
- Stacktrace ->
+ _ ->
erlang:raise(throw, Term, Stacktrace)
end
end
@@ -359,11 +359,11 @@ fold(Fun, Acc0, QH, Options) ->
post_funs(Post)
end
end
- catch Term ->
- case erlang:get_stacktrace() of
+ catch throw:Term:Stacktrace ->
+ case Stacktrace of
[?THROWN_ERROR | _] ->
Term;
- Stacktrace ->
+ _ ->
erlang:raise(throw, Term, Stacktrace)
end
end
@@ -457,11 +457,11 @@ info(QH, Options) ->
debug -> % Not documented. Intended for testing only.
Info
end
- catch Term ->
- case erlang:get_stacktrace() of
+ catch throw:Term:Stacktrace ->
+ case Stacktrace of
[?THROWN_ERROR | _] ->
Term;
- Stacktrace ->
+ _ ->
erlang:raise(throw, Term, Stacktrace)
end
end
@@ -638,7 +638,7 @@ string_to_handle(Str, Options, Bindings) when is_list(Str) ->
case erl_scan:string(Str, 1, [text]) of
{ok, Tokens, _} ->
ScanRes =
- case lib:extended_parse_exprs(Tokens) of
+ case erl_eval:extended_parse_exprs(Tokens) of
{ok, [Expr0], SBs} ->
{ok, Expr0, SBs};
{ok, _ExprList, _SBs} ->
@@ -1056,9 +1056,9 @@ cursor_process(H, GUnique, GCache, TmpDir, SpawnOptions, MaxList, TmpUsage) ->
Prep = prepare_qlc(H, not_a_list, GUnique, GCache,
TmpDir, MaxList, TmpUsage),
setup_qlc(Prep, Setup)
- catch Class:Reason ->
- Parent ! {self(), {caught, Class, Reason,
- erlang:get_stacktrace()}},
+ catch Class:Reason:Stacktrace ->
+ Parent ! {self(),
+ {caught, Class, Reason, Stacktrace}},
exit(normal)
end,
Parent ! {self(), ok},
@@ -1075,8 +1075,8 @@ parent_fun(Pid, Parent) ->
{TPid, {parent_fun, Fun}} ->
V = try
{value, Fun()}
- catch Class:Reason ->
- {parent_fun_caught, Class, Reason, erlang:get_stacktrace()}
+ catch Class:Reason:Stacktrace ->
+ {parent_fun_caught, Class, Reason, Stacktrace}
end,
TPid ! {Parent, V},
parent_fun(Pid, Parent);
@@ -1101,9 +1101,9 @@ reply(Parent, MonRef, Post, Cont) ->
throw_error(Cont)
end
catch
- Class:Reason ->
+ Class:Reason:Stacktrace ->
post_funs(Post),
- Message = {caught, Class, Reason, erlang:get_stacktrace()},
+ Message = {caught, Class, Reason, Stacktrace},
Parent ! {self(), Message},
exit(normal)
end,
@@ -1196,8 +1196,8 @@ abstract1({table, TableDesc}, _NElements, _Depth, _A) ->
{ok, Tokens, _} =
erl_scan:string(lists:flatten(TableDesc++"."), 1, [text]),
{ok, Es, Bs} =
- lib:extended_parse_exprs(Tokens),
- [Expr] = lib:subst_values_for_vars(Es, Bs),
+ erl_eval:extended_parse_exprs(Tokens),
+ [Expr] = erl_eval:subst_values_for_vars(Es, Bs),
special(Expr);
false -> % abstract expression
TableDesc
@@ -1392,9 +1392,8 @@ next_loop(Pid, L, N) when N =/= 0 ->
{caught, throw, Error, [?THROWN_ERROR | _]} ->
Error;
{caught, Class, Reason, Stacktrace} ->
- CurrentStacktrace = try erlang:error(foo)
- catch error:_ -> erlang:get_stacktrace()
- end,
+ {current_stacktrace, CurrentStacktrace} =
+ erlang:process_info(self(), current_stacktrace),
erlang:raise(Class, Reason, Stacktrace ++ CurrentStacktrace);
error ->
erlang:error({qlc_cursor_pid_no_longer_exists, Pid})
@@ -2627,9 +2626,9 @@ table_handle(#qlc_table{trav_fun = TraverseFun, trav_MS = TravMS,
Parent =:= self() ->
try
ParentFun()
- catch Class:Reason ->
+ catch Class:Reason:Stacktrace ->
post_funs(Post),
- erlang:raise(Class, Reason, erlang:get_stacktrace())
+ erlang:raise(Class, Reason, Stacktrace)
end;
true ->
case monitor_request(Parent, {parent_fun, ParentFun}) of
@@ -3033,9 +3032,9 @@ file_sort_handle(H, Kp, SortOptions, TmpDir, Compressed, Post, LocalPost) ->
{terms, BTerms} ->
try
{[binary_to_term(B) || B <- BTerms], Post, LocalPost}
- catch Class:Reason ->
+ catch Class:Reason:Stacktrace ->
post_funs(Post),
- erlang:raise(Class, Reason, erlang:get_stacktrace())
+ erlang:raise(Class, Reason, Stacktrace)
end
end.
@@ -3045,9 +3044,9 @@ do_sort(In, Out, Sort, SortOptions, Post) ->
{error, Reason} -> throw_reason(Reason);
Reply -> Reply
end
- catch Class:Term ->
+ catch Class:Term:Stacktrace ->
post_funs(Post),
- erlang:raise(Class, Term, erlang:get_stacktrace())
+ erlang:raise(Class, Term, Stacktrace)
end.
do_sort(In, Out, sort, SortOptions) ->
@@ -3750,7 +3749,7 @@ maybe_error_logger(Name, Why) ->
expand_stacktrace(),
Trimmer = fun(M, _F, _A) -> M =:= erl_eval end,
Formater = fun(Term, I) -> io_lib:print(Term, I, 80, -1) end,
- X = lib:format_stacktrace(1, Stacktrace, Trimmer, Formater),
+ X = erl_error:format_stacktrace(1, Stacktrace, Trimmer, Formater),
error_logger:Name("qlc: temporary file was needed for ~w\n~ts\n",
[Why, lists:flatten(X)]).
@@ -3797,9 +3796,9 @@ call(undefined, _Arg, Default, _Post) ->
call(Fun, Arg, _Default, Post) ->
try
Fun(Arg)
- catch Class:Reason ->
+ catch Class:Reason:Stacktrace ->
post_funs(Post),
- erlang:raise(Class, Reason, erlang:get_stacktrace())
+ erlang:raise(Class, Reason, Stacktrace)
end.
grd(undefined, _Arg) ->
diff --git a/lib/stdlib/src/rand.erl b/lib/stdlib/src/rand.erl
index 7a8a5e6d4a..362e98006e 100644
--- a/lib/stdlib/src/rand.erl
+++ b/lib/stdlib/src/rand.erl
@@ -21,8 +21,8 @@
%% Multiple PRNG module for Erlang/OTP
%% Copyright (c) 2015-2016 Kenji Rikitake
%%
-%% exrop (xoroshiro116+) added and statistical distribution
-%% improvements by the Erlang/OTP team 2017
+%% exrop (xoroshiro116+) added, statistical distribution
+%% improvements and uniform_real added by the Erlang/OTP team 2017
%% =====================================================================
-module(rand).
@@ -30,10 +30,14 @@
-export([seed_s/1, seed_s/2, seed/1, seed/2,
export_seed/0, export_seed_s/1,
uniform/0, uniform/1, uniform_s/1, uniform_s/2,
+ uniform_real/0, uniform_real_s/1,
jump/0, jump/1,
normal/0, normal/2, normal_s/1, normal_s/3
]).
+%% Debug
+-export([make_float/3, float2str/1, bc64/1]).
+
-compile({inline, [exs64_next/1, exsplus_next/1,
exs1024_next/1, exs1024_calc/2,
exrop_next/1, exrop_next_s/2,
@@ -60,6 +64,10 @@
%% N i evaluated 3 times
(?BSL((Bits), (X), (N)) bor ((X) bsr ((Bits)-(N))))).
+-define(
+ BC(V, N),
+ bc((V), ?BIT((N) - 1), N)).
+
%%-define(TWO_POW_MINUS53, (math:pow(2, -53))).
-define(TWO_POW_MINUS53, 1.11022302462515657e-16).
@@ -84,14 +92,21 @@
%% The 'bits' field indicates how many bits the integer
%% returned from 'next' has got, i.e 'next' shall return
%% an random integer in the range 0..(2^Bits - 1).
-%% At least 53 bits is required for the floating point
-%% producing fallbacks. This field is only used when
-%% the 'uniform' or 'uniform_n' fields are not defined.
+%% At least 55 bits is required for the floating point
+%% producing fallbacks, but 56 bits would be more future proof.
%%
%% The fields 'next', 'uniform' and 'uniform_n'
-%% implement the algorithm. If 'uniform' or 'uinform_n'
+%% implement the algorithm. If 'uniform' or 'uniform_n'
%% is not present there is a fallback using 'next' and either
-%% 'bits' or the deprecated 'max'.
+%% 'bits' or the deprecated 'max'. The 'next' function
+%% must generate a word with at least 56 good random bits.
+%%
+%% The 'weak_low_bits' field indicate how many bits are of
+%% lesser quality and they will not be used by the floating point
+%% producing functions, nor by the range producing functions
+%% when more bits are needed, to avoid weak bits in the middle
+%% of the generated bits. The lowest bits from the range
+%% functions still have the generator's quality.
%%
-type alg_handler() ::
#{type := alg(),
@@ -148,11 +163,7 @@
%% For ranges larger than the algorithm bit size
uniform_range(Range, #{next:=Next, bits:=Bits} = Alg, R, V) ->
- WeakLowBits =
- case Alg of
- #{weak_low_bits:=WLB} -> WLB;
- #{} -> 0
- end,
+ WeakLowBits = maps:get(weak_low_bits, Alg, 0),
%% Maybe waste the lowest bit(s) when shifting in new bits
Shift = Bits - WeakLowBits,
ShiftMask = bnot ?MASK(WeakLowBits),
@@ -297,7 +308,7 @@ uniform_s({#{bits:=Bits, next:=Next} = Alg, R0}) ->
{(V bsr (Bits - 53)) * ?TWO_POW_MINUS53, {Alg, R1}};
uniform_s({#{max:=Max, next:=Next} = Alg, R0}) ->
{V, R1} = Next(R0),
- %% Old broken algorithm with non-uniform density
+ %% Old algorithm with non-uniform density
{V / (Max + 1), {Alg, R1}}.
@@ -317,7 +328,7 @@ uniform_s(N, {#{bits:=Bits, next:=Next} = Alg, R0})
?uniform_range(N, Alg, R1, V, MaxMinusN, I);
uniform_s(N, {#{max:=Max, next:=Next} = Alg, R0})
when is_integer(N), 1 =< N ->
- %% Old broken algorithm with skewed probability
+ %% Old algorithm with skewed probability
%% and gap in ranges > Max
{V, R1} = Next(R0),
if
@@ -328,6 +339,189 @@ uniform_s(N, {#{max:=Max, next:=Next} = Alg, R0})
{trunc(F * N) + 1, {Alg, R1}}
end.
+%% uniform_real/0: returns a random float X where 0.0 < X =< 1.0,
+%% updating the state in the process dictionary.
+
+-spec uniform_real() -> X :: float().
+uniform_real() ->
+ {X, Seed} = uniform_real_s(seed_get()),
+ _ = seed_put(Seed),
+ X.
+
+%% uniform_real_s/1: given a state, uniform_s/1
+%% returns a random float X where 0.0 < X =< 1.0,
+%% and a new state.
+%%
+%% This function does not use the same form of uniformity
+%% as the uniform_s/1 function.
+%%
+%% Instead, this function does not generate numbers with equal
+%% distance in the interval, but rather tries to keep all mantissa
+%% bits random also for small numbers, meaning that the distance
+%% between possible numbers decreases when the numbers
+%% approaches 0.0, as does the possibility for a particular
+%% number. Hence uniformity is preserved.
+%%
+%% To generate 56 bits at the time instead of 53 is actually
+%% a speed optimization since the probability to have to
+%% generate a second word decreases by 1/2 for every extra bit.
+%%
+%% This function generates normalized numbers, so the smallest number
+%% that can be generated is 2^-1022 with the distance 2^-1074
+%% to the next to smallest number, compared to 2^-53 for uniform_s/1.
+%%
+%% This concept of uniformity should work better for applications
+%% where you need to calculate 1.0/X or math:log(X) since those
+%% operations benefits from larger precision approaching 0.0,
+%% and that this function does not return 0.0 nor denormalized
+%% numbers very close to 0.0. The log() operation in The Box-Muller
+%% transformation for normal distribution is an example of this.
+%%
+%%-define(TWO_POW_MINUS55, (math:pow(2, -55))).
+%%-define(TWO_POW_MINUS110, (math:pow(2, -110))).
+%%-define(TWO_POW_MINUS55, 2.7755575615628914e-17).
+%%-define(TWO_POW_MINUS110, 7.7037197775489436e-34).
+%%
+-spec uniform_real_s(State :: state()) -> {X :: float(), NewState :: state()}.
+uniform_real_s({#{bits:=Bits, next:=Next} = Alg, R0}) ->
+ %% Generate a 56 bit number without using the weak low bits.
+ %%
+ %% Be sure to use only 53 bits when multiplying with
+ %% math:pow(2.0, -N) to avoid rounding which would make
+ %% "even" floats more probable than "odd".
+ %%
+ {V1, R1} = Next(R0),
+ M1 = V1 bsr (Bits - 56),
+ if
+ ?BIT(55) =< M1 ->
+ %% We have 56 bits - waste 3
+ {(M1 bsr 3) * math:pow(2.0, -53), {Alg, R1}};
+ ?BIT(54) =< M1 ->
+ %% We have 55 bits - waste 2
+ {(M1 bsr 2) * math:pow(2.0, -54), {Alg, R1}};
+ ?BIT(53) =< M1 ->
+ %% We have 54 bits - waste 1
+ {(M1 bsr 1) * math:pow(2.0, -55), {Alg, R1}};
+ ?BIT(52) =< M1 ->
+ %% We have 53 bits - use all
+ {M1 * math:pow(2.0, -56), {Alg, R1}};
+ true ->
+ %% Need more bits
+ {V2, R2} = Next(R1),
+ uniform_real_s(Alg, Next, M1, -56, R2, V2, Bits)
+ end;
+uniform_real_s({#{max:=_, next:=Next} = Alg, R0}) ->
+ %% Generate a 56 bit number.
+ %% Ignore the weak low bits for these old algorithms,
+ %% just produce something reasonable.
+ %%
+ %% Be sure to use only 53 bits when multiplying with
+ %% math:pow(2.0, -N) to avoid rounding which would make
+ %% "even" floats more probable than "odd".
+ %%
+ {V1, R1} = Next(R0),
+ M1 = ?MASK(56, V1),
+ if
+ ?BIT(55) =< M1 ->
+ %% We have 56 bits - waste 3
+ {(M1 bsr 3) * math:pow(2.0, -53), {Alg, R1}};
+ ?BIT(54) =< M1 ->
+ %% We have 55 bits - waste 2
+ {(M1 bsr 2) * math:pow(2.0, -54), {Alg, R1}};
+ ?BIT(53) =< M1 ->
+ %% We have 54 bits - waste 1
+ {(M1 bsr 1) * math:pow(2.0, -55), {Alg, R1}};
+ ?BIT(52) =< M1 ->
+ %% We have 53 bits - use all
+ {M1 * math:pow(2.0, -56), {Alg, R1}};
+ true ->
+ %% Need more bits
+ {V2, R2} = Next(R1),
+ uniform_real_s(Alg, Next, M1, -56, R2, V2, 56)
+ end.
+
+uniform_real_s(Alg, _Next, M0, -1064, R1, V1, Bits) -> % 19*56
+ %% This is a very theoretical bottom case.
+ %% The odds of getting here is about 2^-1008,
+ %% through a white box test case, or thanks to
+ %% a malfunctioning PRNG producing 18 56-bit zeros in a row.
+ %%
+ %% Fill up to 53 bits, we have at most 52
+ B0 = (53 - ?BC(M0, 52)), % Missing bits
+ {(((M0 bsl B0) bor (V1 bsr (Bits - B0))) * math:pow(2.0, -1064 - B0)),
+ {Alg, R1}};
+uniform_real_s(Alg, Next, M0, BitNo, R1, V1, Bits) ->
+ if
+ %% Optimize the most probable.
+ %% Fill up to 53 bits.
+ ?BIT(51) =< M0 ->
+ %% We have 52 bits in M0 - need 1
+ {(((M0 bsl 1) bor (V1 bsr (Bits - 1)))
+ * math:pow(2.0, BitNo - 1)),
+ {Alg, R1}};
+ ?BIT(50) =< M0 ->
+ %% We have 51 bits in M0 - need 2
+ {(((M0 bsl 2) bor (V1 bsr (Bits - 2)))
+ * math:pow(2.0, BitNo - 2)),
+ {Alg, R1}};
+ ?BIT(49) =< M0 ->
+ %% We have 50 bits in M0 - need 3
+ {(((M0 bsl 3) bor (V1 bsr (Bits - 3)))
+ * math:pow(2.0, BitNo - 3)),
+ {Alg, R1}};
+ M0 == 0 ->
+ M1 = V1 bsr (Bits - 56),
+ if
+ ?BIT(55) =< M1 ->
+ %% We have 56 bits - waste 3
+ {(M1 bsr 3) * math:pow(2.0, BitNo - 53), {Alg, R1}};
+ ?BIT(54) =< M1 ->
+ %% We have 55 bits - waste 2
+ {(M1 bsr 2) * math:pow(2.0, BitNo - 54), {Alg, R1}};
+ ?BIT(53) =< M1 ->
+ %% We have 54 bits - waste 1
+ {(M1 bsr 1) * math:pow(2.0, BitNo - 55), {Alg, R1}};
+ ?BIT(52) =< M1 ->
+ %% We have 53 bits - use all
+ {M1 * math:pow(2.0, BitNo - 56), {Alg, R1}};
+ BitNo =:= -1008 ->
+ %% Endgame
+ %% For the last round we can not have 14 zeros or more
+ %% at the top of M1 because then we will underflow,
+ %% so we need at least 43 bits
+ if
+ ?BIT(42) =< M1 ->
+ %% We have 43 bits - get the last bits
+ uniform_real_s(Alg, Next, M1, BitNo - 56, R1);
+ true ->
+ %% Would underflow 2^-1022 - start all over
+ %%
+ %% We could just crash here since the odds for
+ %% the PRNG being broken is much higher than
+ %% for a good PRNG generating this many zeros
+ %% in a row. Maybe we should write an error
+ %% report or call this a system limit...?
+ uniform_real_s({Alg, R1})
+ end;
+ true ->
+ %% Need more bits
+ uniform_real_s(Alg, Next, M1, BitNo - 56, R1)
+ end;
+ true ->
+ %% Fill up to 53 bits
+ B0 = 53 - ?BC(M0, 49), % Number of bits we need to append
+ {(((M0 bsl B0) bor (V1 bsr (Bits - B0)))
+ * math:pow(2.0, BitNo - B0)),
+ {Alg, R1}}
+ end.
+%%
+uniform_real_s(#{bits:=Bits} = Alg, Next, M0, BitNo, R0) ->
+ {V1, R1} = Next(R0),
+ uniform_real_s(Alg, Next, M0, BitNo, R1, V1, Bits);
+uniform_real_s(#{max:=_} = Alg, Next, M0, BitNo, R0) ->
+ {V1, R1} = Next(R0),
+ uniform_real_s(Alg, Next, M0, BitNo, R1, ?MASK(56, V1), 56).
+
%% jump/1: given a state, jump/1
%% returns a new state which is equivalent to that
%% after a large number of call defined for each algorithm.
@@ -1025,3 +1219,42 @@ normal_fi(Indx) ->
1.0214971439701471e-02,8.6165827693987316e-03,7.0508754713732268e-03,
5.5224032992509968e-03,4.0379725933630305e-03,2.6090727461021627e-03,
1.2602859304985975e-03}).
+
+%%%bitcount64(0) -> 0;
+%%%bitcount64(V) -> 1 + bitcount(V, 64).
+%%%
+%%%-define(
+%%% BITCOUNT(V, N),
+%%% bitcount(V, N) ->
+%%% if
+%%% (1 bsl ((N) bsr 1)) =< (V) ->
+%%% ((N) bsr 1) + bitcount((V) bsr ((N) bsr 1), ((N) bsr 1));
+%%% true ->
+%%% bitcount((V), ((N) bsr 1))
+%%% end).
+%%%?BITCOUNT(V, 64);
+%%%?BITCOUNT(V, 32);
+%%%?BITCOUNT(V, 16);
+%%%?BITCOUNT(V, 8);
+%%%?BITCOUNT(V, 4);
+%%%?BITCOUNT(V, 2);
+%%%bitcount(_, 1) -> 0.
+
+bc64(V) -> ?BC(V, 64).
+
+%% Linear from high bit - higher probability first gives faster execution
+bc(V, B, N) when B =< V -> N;
+bc(V, B, N) -> bc(V, B bsr 1, N - 1).
+
+make_float(S, E, M) ->
+ <<F/float>> = <<S:1, E:11, M:52>>,
+ F.
+
+float2str(N) ->
+ <<S:1, E:11, M:52>> = <<(float(N))/float>>,
+ lists:flatten(
+ io_lib:format(
+ "~c~c.~13.16.0bE~b",
+ [case S of 1 -> $-; 0 -> $+ end,
+ case E of 0 -> $0; _ -> $1 end,
+ M, E - 16#3ff])).
diff --git a/lib/stdlib/src/sets.erl b/lib/stdlib/src/sets.erl
index c65a13b22e..8adb9016e2 100644
--- a/lib/stdlib/src/sets.erl
+++ b/lib/stdlib/src/sets.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2000-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2000-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -37,7 +37,7 @@
-module(sets).
%% Standard interface.
--export([new/0,is_set/1,size/1,to_list/1,from_list/1]).
+-export([new/0,is_set/1,size/1,is_empty/1,to_list/1,from_list/1]).
-export([is_element/2,add_element/2,del_element/2]).
-export([union/2,union/1,intersection/2,intersection/1]).
-export([is_disjoint/2]).
@@ -96,6 +96,12 @@ is_set(_) -> false.
Set :: set().
size(S) -> S#set.size.
+%% is_empty(Set) -> boolean().
+%% Return 'true' if Set is an empty set, otherwise 'false'.
+-spec is_empty(Set) -> boolean() when
+ Set :: set().
+is_empty(S) -> S#set.size=:=0.
+
%% to_list(Set) -> [Elem].
%% Return the elements in Set as a list.
-spec to_list(Set) -> List when
diff --git a/lib/stdlib/src/shell.erl b/lib/stdlib/src/shell.erl
index ad4984b64c..c73cf22943 100644
--- a/lib/stdlib/src/shell.erl
+++ b/lib/stdlib/src/shell.erl
@@ -230,7 +230,7 @@ server_loop(N0, Eval_0, Bs00, RT, Ds00, History0, Results0) ->
{Res,Eval0} = get_command(Prompt, Eval_1, Bs0, RT, Ds0),
case Res of
{ok,Es0,XBs} ->
- Es1 = lib:subst_values_for_vars(Es0, XBs),
+ Es1 = erl_eval:subst_values_for_vars(Es0, XBs),
case expand_hist(Es1, N) of
{ok,Es} ->
{V,Eval,Bs,Ds} = shell_cmd(Es, Eval0, Bs0, RT, Ds0, cmd),
@@ -280,7 +280,7 @@ get_command(Prompt, Eval, Bs, RT, Ds) ->
io:scan_erl_exprs(group_leader(), Prompt, 1, [text])
of
{ok,Toks,_EndPos} ->
- lib:extended_parse_exprs(Toks);
+ erl_eval:extended_parse_exprs(Toks);
{eof,_EndPos} ->
eof;
{error,ErrorInfo,_EndPos} ->
@@ -589,7 +589,7 @@ report_exception(Class, Severity, {Reason,Stacktrace}, RT) ->
PF = fun(Term, I1) -> pp(Term, I1, RT) end,
SF = fun(M, _F, _A) -> (M =:= erl_eval) or (M =:= ?MODULE) end,
Enc = encoding(),
- Str = lib:format_exception(I, Class, Reason, Stacktrace, SF, PF, Enc),
+ Str = erl_error:format_exception(I, Class, Reason, Stacktrace, SF, PF, Enc),
io:requests([{put_chars, latin1, Tag},
{put_chars, unicode, Str},
nl]).
@@ -645,8 +645,7 @@ eval_exprs(Es, Shell, Bs0, RT, Lf, Ef, W) ->
catch
exit:normal ->
exit(normal);
- Class:Reason ->
- Stacktrace = erlang:get_stacktrace(),
+ Class:Reason:Stacktrace ->
M = {self(),Class,{Reason,Stacktrace}},
case do_catch(Class, Reason) of
true ->
@@ -807,8 +806,8 @@ restrict_handlers(RShMod, Shell, RT) ->
-define(BAD_RETURN(M, F, V),
try erlang:error(reason)
- catch _:_ -> erlang:raise(exit, {restricted_shell_bad_return,V},
- [{M,F,3} | erlang:get_stacktrace()])
+ catch _:_:S -> erlang:raise(exit, {restricted_shell_bad_return,V},
+ [{M,F,3} | S])
end).
local_allowed(F, As, RShMod, Bs, Shell, RT) when is_atom(F) ->
@@ -1417,7 +1416,7 @@ pp(V, I, D, RT) ->
true
end,
io_lib_pretty:print(V, ([{column, I}, {line_length, columns()},
- {depth, D}, {max_chars, ?CHAR_MAX},
+ {depth, D}, {line_max_chars, ?CHAR_MAX},
{strings, Strings},
{record_print_fun, record_print_fun(RT)}]
++ enc())).
diff --git a/lib/stdlib/src/slave.erl b/lib/stdlib/src/slave.erl
index d7cf6386f5..5e8c1a43ea 100644
--- a/lib/stdlib/src/slave.erl
+++ b/lib/stdlib/src/slave.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -187,7 +187,7 @@ start_link(Host, Name, Args) ->
start(Host, Name, Args, self()).
start(Host0, Name, Args, LinkTo) ->
- Prog = lib:progname(),
+ Prog = progname(),
start(Host0, Name, Args, LinkTo, Prog).
start(Host0, Name, Args, LinkTo, Prog) ->
@@ -296,7 +296,6 @@ mk_cmd(Host, Name, Args, Waiter, Prog0) ->
" -s slave slave_start ", node(),
" ", Waiter,
" ", Args]),
-
case after_char($@, atom_to_list(node())) of
Host ->
{ok, BasicCmd};
@@ -309,6 +308,15 @@ mk_cmd(Host, Name, Args, Waiter, Prog0) ->
end
end.
+%% Return the name of the script that starts (this) erlang
+progname() ->
+ case init:get_argument(progname) of
+ {ok, [[Prog]]} ->
+ Prog;
+ _Other ->
+ "no_prog_name"
+ end.
+
%% This is an attempt to distinguish between spaces in the program
%% path and spaces that separate arguments. The program is quoted to
%% allow spaces in the path.
@@ -317,10 +325,10 @@ mk_cmd(Host, Name, Args, Waiter, Prog0) ->
%% (through start/5) or if the -program switch to beam is used and
%% includes arguments (typically done by cerl in OTP test environment
%% in order to ensure that slave/peer nodes are started with the same
-%% emulator and flags as the test node. The return from lib:progname()
+%% emulator and flags as the test node. The result from progname()
%% could then typically be '/<full_path_to>/cerl -gcov').
quote_progname(Progname) ->
- do_quote_progname(string:tokens(to_list(Progname)," ")).
+ do_quote_progname(string:lexemes(to_list(Progname)," ")).
do_quote_progname([Prog]) ->
"\""++Prog++"\"";
diff --git a/lib/stdlib/src/stdlib.app.src b/lib/stdlib/src/stdlib.app.src
index 3c449d3cb9..cd09872b87 100644
--- a/lib/stdlib/src/stdlib.app.src
+++ b/lib/stdlib/src/stdlib.app.src
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -43,6 +43,7 @@
erl_anno,
erl_bits,
erl_compile,
+ erl_error,
erl_eval,
erl_expand_records,
erl_internal,
@@ -71,7 +72,6 @@
io_lib_format,
io_lib_fread,
io_lib_pretty,
- lib,
lists,
log_mf_h,
maps,
@@ -101,13 +101,14 @@
timer,
unicode,
unicode_util,
+ uri_string,
win32reg,
zip]},
{registered,[timer_server,rsh_starter,take_over_monitor,pool_master,
dets]},
{applications, [kernel]},
{env, []},
- {runtime_dependencies, ["sasl-3.0","kernel-5.0","erts-9.0","crypto-3.3",
+ {runtime_dependencies, ["sasl-3.0","kernel-6.0","erts-10.0","crypto-3.3",
"compiler-5.0"]}
]}.
diff --git a/lib/stdlib/src/stdlib.appup.src b/lib/stdlib/src/stdlib.appup.src
index 800c2c61f3..8c0b186288 100644
--- a/lib/stdlib/src/stdlib.appup.src
+++ b/lib/stdlib/src/stdlib.appup.src
@@ -18,9 +18,11 @@
%% %CopyrightEnd%
{"%VSN%",
%% Up from - max one major revision back
- [{<<"3\\.[0-3](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-19.*
- {<<"3\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-20.*
+ [{<<"3\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-20.*
+ {<<"3\\.5(\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-21.0
+ {<<"3\\.6(\\.[0-9]+)*">>,[restart_new_emulator]}],% OTP-21.1
%% Down to - max one major revision back
- [{<<"3\\.[0-3](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-19.*
- {<<"3\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-20.*
+ [{<<"3\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-20.*
+ {<<"3\\.5(\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-21.0
+ {<<"3\\.6(\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-21.1
}.
diff --git a/lib/stdlib/src/string.erl b/lib/stdlib/src/string.erl
index 6f5e617230..2939e78d9d 100644
--- a/lib/stdlib/src/string.erl
+++ b/lib/stdlib/src/string.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -88,7 +88,6 @@
%%% May be removed
-export([list_to_float/1, list_to_integer/1]).
-
%% Uses bifs: string:list_to_float/1 and string:list_to_integer/1
-spec list_to_float(String) -> {Float, Rest} | {'error', Reason} when
String :: string(),
@@ -324,16 +323,30 @@ take(Str, Sep0, true, trailing) ->
%% Uppercase all chars in Str
-spec uppercase(String::unicode:chardata()) -> unicode:chardata().
uppercase(CD) when is_list(CD) ->
- uppercase_list(CD);
-uppercase(CD) when is_binary(CD) ->
- uppercase_bin(CD,<<>>).
+ try uppercase_list(CD, false)
+ catch unchanged -> CD
+ end;
+uppercase(<<CP1/utf8, Rest/binary>>=Orig) ->
+ try uppercase_bin(CP1, Rest, false) of
+ List -> unicode:characters_to_binary(List)
+ catch unchanged -> Orig
+ end;
+uppercase(<<>>) ->
+ <<>>.
%% Lowercase all chars in Str
-spec lowercase(String::unicode:chardata()) -> unicode:chardata().
lowercase(CD) when is_list(CD) ->
- lowercase_list(CD);
-lowercase(CD) when is_binary(CD) ->
- lowercase_bin(CD,<<>>).
+ try lowercase_list(CD, false)
+ catch unchanged -> CD
+ end;
+lowercase(<<CP1/utf8, Rest/binary>>=Orig) ->
+ try lowercase_bin(CP1, Rest, false) of
+ List -> unicode:characters_to_binary(List)
+ catch unchanged -> Orig
+ end;
+lowercase(<<>>) ->
+ <<>>.
%% Make a titlecase of the first char in Str
-spec titlecase(String::unicode:chardata()) -> unicode:chardata().
@@ -353,9 +366,16 @@ titlecase(CD) when is_binary(CD) ->
%% Make a comparable string of the Str should be used for equality tests only
-spec casefold(String::unicode:chardata()) -> unicode:chardata().
casefold(CD) when is_list(CD) ->
- casefold_list(CD);
-casefold(CD) when is_binary(CD) ->
- casefold_bin(CD,<<>>).
+ try casefold_list(CD, false)
+ catch unchanged -> CD
+ end;
+casefold(<<CP1/utf8, Rest/binary>>=Orig) ->
+ try casefold_bin(CP1, Rest, false) of
+ List -> unicode:characters_to_binary(List)
+ catch unchanged -> Orig
+ end;
+casefold(<<>>) ->
+ <<>>.
-spec to_integer(String) -> {Int, Rest} | {'error', Reason} when
String :: unicode:chardata(),
@@ -653,52 +673,127 @@ slice_bin(CD, CP1, N) when N > 0 ->
slice_bin(CD, CP1, 0) ->
byte_size(CD)+byte_size(<<CP1/utf8>>).
-uppercase_list(CPs0) ->
+uppercase_list([CP1|[CP2|_]=Cont], _Changed) when $a =< CP1, CP1 =< $z, CP2 < 256 ->
+ [CP1-32|uppercase_list(Cont, true)];
+uppercase_list([CP1|[CP2|_]=Cont], Changed) when CP1 < 128, CP2 < 256 ->
+ [CP1|uppercase_list(Cont, Changed)];
+uppercase_list([], true) ->
+ [];
+uppercase_list([], false) ->
+ throw(unchanged);
+uppercase_list(CPs0, Changed) ->
case unicode_util:uppercase(CPs0) of
- [Char|CPs] -> append(Char,uppercase_list(CPs));
- [] -> []
+ [Char|CPs] when Char =:= hd(CPs0) -> [Char|uppercase_list(CPs, Changed)];
+ [Char|CPs] -> append(Char,uppercase_list(CPs, true));
+ [] -> uppercase_list([], Changed)
end.
-uppercase_bin(CPs0, Acc) ->
- case unicode_util:uppercase(CPs0) of
- [Char|CPs] when is_integer(Char) ->
- uppercase_bin(CPs, <<Acc/binary, Char/utf8>>);
- [Chars|CPs] ->
- uppercase_bin(CPs, <<Acc/binary,
- << <<CP/utf8>> || CP <- Chars>>/binary >>);
- [] -> Acc
+uppercase_bin(CP1, <<CP2/utf8, Bin/binary>>, _Changed)
+ when $a =< CP1, CP1 =< $z, CP2 < 256 ->
+ [CP1-32|uppercase_bin(CP2, Bin, true)];
+uppercase_bin(CP1, <<CP2/utf8, Bin/binary>>, Changed)
+ when CP1 < 128, CP2 < 256 ->
+ [CP1|uppercase_bin(CP2, Bin, Changed)];
+uppercase_bin(CP1, Bin, Changed) ->
+ case unicode_util:uppercase([CP1|Bin]) of
+ [CP1|CPs] ->
+ case unicode_util:cp(CPs) of
+ [Next|Rest] ->
+ [CP1|uppercase_bin(Next, Rest, Changed)];
+ [] when Changed ->
+ [CP1];
+ [] ->
+ throw(unchanged)
+ end;
+ [Char|CPs] ->
+ case unicode_util:cp(CPs) of
+ [Next|Rest] ->
+ [Char|uppercase_bin(Next, Rest, true)];
+ [] ->
+ [Char]
+ end
end.
-lowercase_list(CPs0) ->
+lowercase_list([CP1|[CP2|_]=Cont], _Changed) when $A =< CP1, CP1 =< $Z, CP2 < 256 ->
+ [CP1+32|lowercase_list(Cont, true)];
+lowercase_list([CP1|[CP2|_]=Cont], Changed) when CP1 < 128, CP2 < 256 ->
+ [CP1|lowercase_list(Cont, Changed)];
+lowercase_list([], true) ->
+ [];
+lowercase_list([], false) ->
+ throw(unchanged);
+lowercase_list(CPs0, Changed) ->
case unicode_util:lowercase(CPs0) of
- [Char|CPs] -> append(Char,lowercase_list(CPs));
- [] -> []
+ [Char|CPs] when Char =:= hd(CPs0) -> [Char|lowercase_list(CPs, Changed)];
+ [Char|CPs] -> append(Char,lowercase_list(CPs, true));
+ [] -> lowercase_list([], Changed)
end.
-lowercase_bin(CPs0, Acc) ->
- case unicode_util:lowercase(CPs0) of
- [Char|CPs] when is_integer(Char) ->
- lowercase_bin(CPs, <<Acc/binary, Char/utf8>>);
- [Chars|CPs] ->
- lowercase_bin(CPs, <<Acc/binary,
- << <<CP/utf8>> || CP <- Chars>>/binary >>);
- [] -> Acc
+lowercase_bin(CP1, <<CP2/utf8, Bin/binary>>, _Changed)
+ when $A =< CP1, CP1 =< $Z, CP2 < 256 ->
+ [CP1+32|lowercase_bin(CP2, Bin, true)];
+lowercase_bin(CP1, <<CP2/utf8, Bin/binary>>, Changed)
+ when CP1 < 128, CP2 < 256 ->
+ [CP1|lowercase_bin(CP2, Bin, Changed)];
+lowercase_bin(CP1, Bin, Changed) ->
+ case unicode_util:lowercase([CP1|Bin]) of
+ [CP1|CPs] ->
+ case unicode_util:cp(CPs) of
+ [Next|Rest] ->
+ [CP1|lowercase_bin(Next, Rest, Changed)];
+ [] when Changed ->
+ [CP1];
+ [] ->
+ throw(unchanged)
+ end;
+ [Char|CPs] ->
+ case unicode_util:cp(CPs) of
+ [Next|Rest] ->
+ [Char|lowercase_bin(Next, Rest, true)];
+ [] ->
+ [Char]
+ end
end.
-casefold_list(CPs0) ->
+casefold_list([CP1|[CP2|_]=Cont], _Changed) when $A =< CP1, CP1 =< $Z, CP2 < 256 ->
+ [CP1+32|casefold_list(Cont, true)];
+casefold_list([CP1|[CP2|_]=Cont], Changed) when CP1 < 128, CP2 < 256 ->
+ [CP1|casefold_list(Cont, Changed)];
+casefold_list([], true) ->
+ [];
+casefold_list([], false) ->
+ throw(unchanged);
+casefold_list(CPs0, Changed) ->
case unicode_util:casefold(CPs0) of
- [Char|CPs] -> append(Char, casefold_list(CPs));
- [] -> []
+ [Char|CPs] when Char =:= hd(CPs0) -> [Char|casefold_list(CPs, Changed)];
+ [Char|CPs] -> append(Char,casefold_list(CPs, true));
+ [] -> casefold_list([], Changed)
end.
-casefold_bin(CPs0, Acc) ->
- case unicode_util:casefold(CPs0) of
- [Char|CPs] when is_integer(Char) ->
- casefold_bin(CPs, <<Acc/binary, Char/utf8>>);
- [Chars|CPs] ->
- casefold_bin(CPs, <<Acc/binary,
- << <<CP/utf8>> || CP <- Chars>>/binary >>);
- [] -> Acc
+casefold_bin(CP1, <<CP2/utf8, Bin/binary>>, _Changed)
+ when $A =< CP1, CP1 =< $Z, CP2 < 256 ->
+ [CP1+32|casefold_bin(CP2, Bin, true)];
+casefold_bin(CP1, <<CP2/utf8, Bin/binary>>, Changed)
+ when CP1 < 128, CP2 < 256 ->
+ [CP1|casefold_bin(CP2, Bin, Changed)];
+casefold_bin(CP1, Bin, Changed) ->
+ case unicode_util:casefold([CP1|Bin]) of
+ [CP1|CPs] ->
+ case unicode_util:cp(CPs) of
+ [Next|Rest] ->
+ [CP1|casefold_bin(Next, Rest, Changed)];
+ [] when Changed ->
+ [CP1];
+ [] ->
+ throw(unchanged)
+ end;
+ [Char|CPs] ->
+ case unicode_util:cp(CPs) of
+ [Next|Rest] ->
+ [Char|casefold_bin(Next, Rest, true)];
+ [] ->
+ [Char]
+ end
end.
%% Fast path for ascii searching for one character in lists
diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl
index 7920e55930..1ac7334830 100644
--- a/lib/stdlib/src/supervisor.erl
+++ b/lib/stdlib/src/supervisor.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -31,11 +31,24 @@
%% Internal exports
-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
terminate/2, code_change/3, format_status/2]).
--export([try_again_restart/2]).
%% For release_handler only
-export([get_callback_module/1]).
+-include("logger.hrl").
+
+-define(report_error(Error, Reason, Child, SupName),
+ ?LOG_ERROR(#{label=>{supervisor,Error},
+ report=>[{supervisor,SupName},
+ {errorContext,Error},
+ {reason,Reason},
+ {offender,extract_child(Child)}]},
+ #{domain=>[otp,sasl],
+ report_cb=>fun logger:format_otp_report/1,
+ logger_formatter=>#{title=>"SUPERVISOR REPORT"},
+ error_logger=>#{tag=>error_report,
+ type=>supervisor_report}})).
+
%%--------------------------------------------------------------------------
-export_type([sup_flags/0, child_spec/0, startchild_ret/0, strategy/0]).
@@ -79,6 +92,7 @@
| {RestartStrategy :: strategy(),
Intensity :: non_neg_integer(),
Period :: pos_integer()}.
+-type children() :: {Ids :: [child_id()], Db :: #{child_id() => child_rec()}}.
%%--------------------------------------------------------------------------
%% Defaults
@@ -96,7 +110,7 @@
pid = undefined :: child()
| {restarting, pid() | undefined}
| [pid()],
- name :: child_id(),
+ id :: child_id(),
mfargs :: mfargs(),
restart_type :: restart(),
shutdown :: shutdown(),
@@ -104,16 +118,11 @@
modules = [] :: modules()}).
-type child_rec() :: #child{}.
--define(DICTS, dict).
--define(DICT, dict:dict).
--define(SETS, sets).
--define(SET, sets:set).
-
-record(state, {name,
strategy :: strategy() | 'undefined',
- children = [] :: [child_rec()],
- dynamics :: {'dict', ?DICT(pid(), list())}
- | {'set', ?SET(pid())}
+ children = {[],#{}} :: children(), % Ids in start order
+ dynamics :: {'maps', #{pid() => list()}}
+ | {'sets', sets:set(pid())}
| 'undefined',
intensity :: non_neg_integer() | 'undefined',
period :: pos_integer() | 'undefined',
@@ -124,6 +133,9 @@
-type state() :: #state{}.
-define(is_simple(State), State#state.strategy =:= simple_one_for_one).
+-define(is_temporary(_Child_), _Child_#child.restart_type=:=temporary).
+-define(is_transient(_Child_), _Child_#child.restart_type=:=transient).
+-define(is_permanent(_Child_), _Child_#child.restart_type=:=permanent).
-callback init(Args :: term()) ->
{ok, {SupFlags :: sup_flags(), [ChildSpec :: child_spec()]}}
@@ -179,16 +191,16 @@ start_child(Supervisor, ChildSpec) ->
| {'error', Error},
Error :: 'running' | 'restarting' | 'not_found' | 'simple_one_for_one' |
term().
-restart_child(Supervisor, Name) ->
- call(Supervisor, {restart_child, Name}).
+restart_child(Supervisor, Id) ->
+ call(Supervisor, {restart_child, Id}).
-spec delete_child(SupRef, Id) -> Result when
SupRef :: sup_ref(),
Id :: child_id(),
Result :: 'ok' | {'error', Error},
Error :: 'running' | 'restarting' | 'not_found' | 'simple_one_for_one'.
-delete_child(Supervisor, Name) ->
- call(Supervisor, {delete_child, Name}).
+delete_child(Supervisor, Id) ->
+ call(Supervisor, {delete_child, Id}).
%%-----------------------------------------------------------------
%% Func: terminate_child/2
@@ -202,16 +214,16 @@ delete_child(Supervisor, Name) ->
Id :: pid() | child_id(),
Result :: 'ok' | {'error', Error},
Error :: 'not_found' | 'simple_one_for_one'.
-terminate_child(Supervisor, Name) ->
- call(Supervisor, {terminate_child, Name}).
+terminate_child(Supervisor, Id) ->
+ call(Supervisor, {terminate_child, Id}).
-spec get_childspec(SupRef, Id) -> Result when
SupRef :: sup_ref(),
Id :: pid() | child_id(),
Result :: {'ok', child_spec()} | {'error', Error},
Error :: 'not_found'.
-get_childspec(Supervisor, Name) ->
- call(Supervisor, {get_childspec, Name}).
+get_childspec(Supervisor, Id) ->
+ call(Supervisor, {get_childspec, Id}).
-spec which_children(SupRef) -> [{Id,Child,Type,Modules}] when
SupRef :: sup_ref(),
@@ -246,17 +258,6 @@ check_childspecs(ChildSpecs) when is_list(ChildSpecs) ->
check_childspecs(X) -> {error, {badarg, X}}.
%%%-----------------------------------------------------------------
-%%% Called by restart/2
--spec try_again_restart(SupRef, Child) -> ok when
- SupRef :: sup_ref(),
- Child :: child_id() | pid().
-try_again_restart(Supervisor, Child) ->
- cast(Supervisor, {try_again_restart, Child}).
-
-cast(Supervisor, Req) ->
- gen_server:cast(Supervisor, Req).
-
-%%%-----------------------------------------------------------------
%%% Called by release_handler during upgrade
-spec get_callback_module(Pid) -> Module when
Pid :: pid(),
@@ -325,7 +326,7 @@ init_children(State, StartSpec) ->
init_dynamic(State, [StartSpec]) ->
case check_startspec([StartSpec]) of
{ok, Children} ->
- {ok, State#state{children = Children}};
+ {ok, dyn_init(State#state{children = Children})};
Error ->
{stop, {start_spec, Error}}
end;
@@ -334,35 +335,34 @@ init_dynamic(_State, StartSpec) ->
%%-----------------------------------------------------------------
%% Func: start_children/2
-%% Args: Children = [child_rec()] in start order
+%% Args: Children = children() % Ids in start order
%% SupName = {local, atom()} | {global, atom()} | {pid(), Mod}
-%% Purpose: Start all children. The new list contains #child's
+%% Purpose: Start all children. The new map contains #child's
%% with pids.
%% Returns: {ok, NChildren} | {error, NChildren, Reason}
-%% NChildren = [child_rec()] in termination order (reversed
-%% start order)
+%% NChildren = children() % Ids in termination order
+%% (reversed start order)
%%-----------------------------------------------------------------
-start_children(Children, SupName) -> start_children(Children, [], SupName).
-
-start_children([Child|Chs], NChildren, SupName) ->
- case do_start_child(SupName, Child) of
- {ok, undefined} when Child#child.restart_type =:= temporary ->
- start_children(Chs, NChildren, SupName);
- {ok, Pid} ->
- start_children(Chs, [Child#child{pid = Pid}|NChildren], SupName);
- {ok, Pid, _Extra} ->
- start_children(Chs, [Child#child{pid = Pid}|NChildren], SupName);
- {error, Reason} ->
- report_error(start_error, Reason, Child, SupName),
- {error, lists:reverse(Chs) ++ [Child | NChildren],
- {failed_to_start_child,Child#child.name,Reason}}
- end;
-start_children([], NChildren, _SupName) ->
- {ok, NChildren}.
+start_children(Children, SupName) ->
+ Start =
+ fun(Id,Child) ->
+ case do_start_child(SupName, Child) of
+ {ok, undefined} when ?is_temporary(Child) ->
+ remove;
+ {ok, Pid} ->
+ {update,Child#child{pid = Pid}};
+ {ok, Pid, _Extra} ->
+ {update,Child#child{pid = Pid}};
+ {error, Reason} ->
+ ?report_error(start_error, Reason, Child, SupName),
+ {abort,{failed_to_start_child,Id,Reason}}
+ end
+ end,
+ children_map(Start,Children).
do_start_child(SupName, Child) ->
#child{mfargs = {M, F, Args}} = Child,
- case catch apply(M, F, Args) of
+ case do_start_child_i(M, F, Args) of
{ok, Pid} when is_pid(Pid) ->
NChild = Child#child{pid = Pid},
report_progress(NChild, SupName),
@@ -371,10 +371,8 @@ do_start_child(SupName, Child) ->
NChild = Child#child{pid = Pid},
report_progress(NChild, SupName),
{ok, Pid, Extra};
- ignore ->
- {ok, undefined};
- {error, What} -> {error, What};
- What -> {error, What}
+ Other ->
+ Other
end.
do_start_child_i(M, F, A) ->
@@ -400,17 +398,17 @@ do_start_child_i(M, F, A) ->
-spec handle_call(call(), term(), state()) -> {'reply', term(), state()}.
handle_call({start_child, EArgs}, _From, State) when ?is_simple(State) ->
- Child = hd(State#state.children),
+ Child = get_dynamic_child(State),
#child{mfargs = {M, F, A}} = Child,
Args = A ++ EArgs,
case do_start_child_i(M, F, Args) of
{ok, undefined} ->
{reply, {ok, undefined}, State};
{ok, Pid} ->
- NState = save_dynamic_child(Child#child.restart_type, Pid, Args, State),
+ NState = dyn_store(Pid, Args, State),
{reply, {ok, Pid}, NState};
{ok, Pid, Extra} ->
- NState = save_dynamic_child(Child#child.restart_type, Pid, Args, State),
+ NState = dyn_store(Pid, Args, State),
{reply, {ok, Pid, Extra}, NState};
What ->
{reply, What, State}
@@ -426,121 +424,94 @@ handle_call({start_child, ChildSpec}, _From, State) ->
end;
%% terminate_child for simple_one_for_one can only be done with pid
-handle_call({terminate_child, Name}, _From, State) when not is_pid(Name),
- ?is_simple(State) ->
+handle_call({terminate_child, Id}, _From, State) when not is_pid(Id),
+ ?is_simple(State) ->
{reply, {error, simple_one_for_one}, State};
-handle_call({terminate_child, Name}, _From, State) ->
- case get_child(Name, State, ?is_simple(State)) of
- {value, Child} ->
- case do_terminate(Child, State#state.name) of
- #child{restart_type=RT} when RT=:=temporary; ?is_simple(State) ->
- {reply, ok, state_del_child(Child, State)};
- NChild ->
- {reply, ok, replace_child(NChild, State)}
- end;
- false ->
+handle_call({terminate_child, Id}, _From, State) ->
+ case find_child(Id, State) of
+ {ok, Child} ->
+ do_terminate(Child, State#state.name),
+ {reply, ok, del_child(Child, State)};
+ error ->
{reply, {error, not_found}, State}
end;
%% restart_child request is invalid for simple_one_for_one supervisors
-handle_call({restart_child, _Name}, _From, State) when ?is_simple(State) ->
+handle_call({restart_child, _Id}, _From, State) when ?is_simple(State) ->
{reply, {error, simple_one_for_one}, State};
-handle_call({restart_child, Name}, _From, State) ->
- case get_child(Name, State) of
- {value, Child} when Child#child.pid =:= undefined ->
+handle_call({restart_child, Id}, _From, State) ->
+ case find_child(Id, State) of
+ {ok, Child} when Child#child.pid =:= undefined ->
case do_start_child(State#state.name, Child) of
{ok, Pid} ->
- NState = replace_child(Child#child{pid = Pid}, State),
+ NState = set_pid(Pid, Id, State),
{reply, {ok, Pid}, NState};
{ok, Pid, Extra} ->
- NState = replace_child(Child#child{pid = Pid}, State),
+ NState = set_pid(Pid, Id, State),
{reply, {ok, Pid, Extra}, NState};
Error ->
{reply, Error, State}
end;
- {value, #child{pid=?restarting(_)}} ->
+ {ok, #child{pid=?restarting(_)}} ->
{reply, {error, restarting}, State};
- {value, _} ->
+ {ok, _} ->
{reply, {error, running}, State};
_ ->
{reply, {error, not_found}, State}
end;
%% delete_child request is invalid for simple_one_for_one supervisors
-handle_call({delete_child, _Name}, _From, State) when ?is_simple(State) ->
+handle_call({delete_child, _Id}, _From, State) when ?is_simple(State) ->
{reply, {error, simple_one_for_one}, State};
-handle_call({delete_child, Name}, _From, State) ->
- case get_child(Name, State) of
- {value, Child} when Child#child.pid =:= undefined ->
- NState = remove_child(Child, State),
+handle_call({delete_child, Id}, _From, State) ->
+ case find_child(Id, State) of
+ {ok, Child} when Child#child.pid =:= undefined ->
+ NState = remove_child(Id, State),
{reply, ok, NState};
- {value, #child{pid=?restarting(_)}} ->
+ {ok, #child{pid=?restarting(_)}} ->
{reply, {error, restarting}, State};
- {value, _} ->
+ {ok, _} ->
{reply, {error, running}, State};
_ ->
{reply, {error, not_found}, State}
end;
-handle_call({get_childspec, Name}, _From, State) ->
- case get_child(Name, State, ?is_simple(State)) of
- {value, Child} ->
+handle_call({get_childspec, Id}, _From, State) ->
+ case find_child(Id, State) of
+ {ok, Child} ->
{reply, {ok, child_to_spec(Child)}, State};
- false ->
+ error ->
{reply, {error, not_found}, State}
end;
-handle_call(which_children, _From, #state{children = [#child{restart_type = temporary,
- child_type = CT,
- modules = Mods}]} =
- State) when ?is_simple(State) ->
- Reply = lists:map(fun(Pid) -> {undefined, Pid, CT, Mods} end,
- ?SETS:to_list(dynamics_db(temporary, State#state.dynamics))),
- {reply, Reply, State};
-
-handle_call(which_children, _From, #state{children = [#child{restart_type = RType,
- child_type = CT,
- modules = Mods}]} =
- State) when ?is_simple(State) ->
- Reply = lists:map(fun({?restarting(_),_}) -> {undefined,restarting,CT,Mods};
- ({Pid, _}) -> {undefined, Pid, CT, Mods} end,
- ?DICTS:to_list(dynamics_db(RType, State#state.dynamics))),
+handle_call(which_children, _From, State) when ?is_simple(State) ->
+ #child{child_type = CT,modules = Mods} = get_dynamic_child(State),
+ Reply = dyn_map(fun(?restarting(_)) -> {undefined, restarting, CT, Mods};
+ (Pid) -> {undefined, Pid, CT, Mods}
+ end, State),
{reply, Reply, State};
handle_call(which_children, _From, State) ->
Resp =
- lists:map(fun(#child{pid = ?restarting(_), name = Name,
- child_type = ChildType, modules = Mods}) ->
- {Name, restarting, ChildType, Mods};
- (#child{pid = Pid, name = Name,
- child_type = ChildType, modules = Mods}) ->
- {Name, Pid, ChildType, Mods}
- end,
- State#state.children),
+ children_to_list(
+ fun(Id,#child{pid = ?restarting(_),
+ child_type = ChildType, modules = Mods}) ->
+ {Id, restarting, ChildType, Mods};
+ (Id,#child{pid = Pid,
+ child_type = ChildType, modules = Mods}) ->
+ {Id, Pid, ChildType, Mods}
+ end,
+ State#state.children),
{reply, Resp, State};
-
-handle_call(count_children, _From, #state{children = [#child{restart_type = temporary,
- child_type = CT}]} = State)
+handle_call(count_children, _From, #state{dynamic_restarts = Restarts} = State)
when ?is_simple(State) ->
- Sz = ?SETS:size(dynamics_db(temporary, State#state.dynamics)),
- Reply = case CT of
- supervisor -> [{specs, 1}, {active, Sz},
- {supervisors, Sz}, {workers, 0}];
- worker -> [{specs, 1}, {active, Sz},
- {supervisors, 0}, {workers, Sz}]
- end,
- {reply, Reply, State};
-
-handle_call(count_children, _From, #state{dynamic_restarts = Restarts,
- children = [#child{restart_type = RType,
- child_type = CT}]} = State)
- when ?is_simple(State) ->
- Sz = ?DICTS:size(dynamics_db(RType, State#state.dynamics)),
- Active = Sz - Restarts,
+ #child{child_type = CT} = get_dynamic_child(State),
+ Sz = dyn_size(State),
+ Active = Sz - Restarts, % Restarts is always 0 for temporary children
Reply = case CT of
supervisor -> [{specs, 1}, {active, Active},
{supervisors, Sz}, {workers, 0}];
@@ -552,16 +523,15 @@ handle_call(count_children, _From, #state{dynamic_restarts = Restarts,
handle_call(count_children, _From, State) ->
%% Specs and children are together on the children list...
{Specs, Active, Supers, Workers} =
- lists:foldl(fun(Child, Counts) ->
- count_child(Child, Counts)
- end, {0,0,0,0}, State#state.children),
+ children_fold(fun(_Id, Child, Counts) ->
+ count_child(Child, Counts)
+ end, {0,0,0,0}, State#state.children),
%% Reformat counts to a property list.
Reply = [{specs, Specs}, {active, Active},
{supervisors, Supers}, {workers, Workers}],
{reply, Reply, State}.
-
count_child(#child{pid = Pid, child_type = worker},
{Specs, Active, Supers, Workers}) ->
case is_pid(Pid) andalso is_process_alive(Pid) of
@@ -575,34 +545,15 @@ count_child(#child{pid = Pid, child_type = supervisor},
false -> {Specs+1, Active, Supers+1, Workers}
end.
-
%%% If a restart attempt failed, this message is cast
%%% from restart/2 in order to give gen_server the chance to
%%% check it's inbox before trying again.
--spec handle_cast({try_again_restart, child_id() | pid()}, state()) ->
+-spec handle_cast({try_again_restart, child_id() | {'restarting',pid()}}, state()) ->
{'noreply', state()} | {stop, shutdown, state()}.
-handle_cast({try_again_restart,Pid}, #state{children=[Child]}=State)
- when ?is_simple(State) ->
- RT = Child#child.restart_type,
- RPid = restarting(Pid),
- case dynamic_child_args(RPid, RT, State#state.dynamics) of
- {ok, Args} ->
- {M, F, _} = Child#child.mfargs,
- NChild = Child#child{pid = RPid, mfargs = {M, F, Args}},
- case restart(NChild,State) of
- {ok, State1} ->
- {noreply, State1};
- {shutdown, State1} ->
- {stop, shutdown, State1}
- end;
- error ->
- {noreply, State}
- end;
-
-handle_cast({try_again_restart,Name}, State) ->
- case lists:keyfind(Name,#child.name,State#state.children) of
- Child = #child{pid=?restarting(_)} ->
+handle_cast({try_again_restart,TryAgainId}, State) ->
+ case find_child_and_args(TryAgainId, State) of
+ {ok, Child = #child{pid=?restarting(_)}} ->
case restart(Child,State) of
{ok, State1} ->
{noreply, State1};
@@ -628,8 +579,9 @@ handle_info({'EXIT', Pid, Reason}, State) ->
end;
handle_info(Msg, State) ->
- error_logger:error_msg("Supervisor received unexpected message: ~tp~n",
- [Msg]),
+ ?LOG_ERROR("Supervisor received unexpected message: ~tp~n",[Msg],
+ #{domain=>[otp],
+ error_logger=>#{tag=>error}}),
{noreply, State}.
%%
@@ -637,10 +589,8 @@ handle_info(Msg, State) ->
%%
-spec terminate(term(), state()) -> 'ok'.
-terminate(_Reason, #state{children=[Child]} = State) when ?is_simple(State) ->
- terminate_dynamic_children(Child, dynamics_db(Child#child.restart_type,
- State#state.dynamics),
- State#state.name);
+terminate(_Reason, State) when ?is_simple(State) ->
+ terminate_dynamic_children(State);
terminate(_Reason, State) ->
terminate_children(State#state.children, State#state.name).
@@ -675,8 +625,8 @@ code_change(_, State, _) ->
update_childspec(State, StartSpec) when ?is_simple(State) ->
case check_startspec(StartSpec) of
- {ok, [Child]} ->
- {ok, State#state{children = [Child]}};
+ {ok, {[_],_}=Children} ->
+ {ok, State#state{children = Children}};
Error ->
{error, Error}
end;
@@ -690,39 +640,36 @@ update_childspec(State, StartSpec) ->
{error, Error}
end.
-update_childspec1([Child|OldC], Children, KeepOld) ->
- case update_chsp(Child, Children) of
- {ok,NewChildren} ->
- update_childspec1(OldC, NewChildren, KeepOld);
+update_childspec1({[Id|OldIds], OldDb}, {Ids,Db}, KeepOld) ->
+ case update_chsp(maps:get(Id,OldDb), Db) of
+ {ok,NewDb} ->
+ update_childspec1({OldIds,OldDb}, {Ids,NewDb}, KeepOld);
false ->
- update_childspec1(OldC, Children, [Child|KeepOld])
+ update_childspec1({OldIds,OldDb}, {Ids,Db}, [Id|KeepOld])
end;
-update_childspec1([], Children, KeepOld) ->
+update_childspec1({[],OldDb}, {Ids,Db}, KeepOld) ->
+ KeepOldDb = maps:with(KeepOld,OldDb),
%% Return them in (kept) reverse start order.
- lists:reverse(Children ++ KeepOld).
-
-update_chsp(OldCh, Children) ->
- case lists:map(fun(Ch) when OldCh#child.name =:= Ch#child.name ->
- Ch#child{pid = OldCh#child.pid};
- (Ch) ->
- Ch
- end,
- Children) of
- Children ->
- false; % OldCh not found in new spec.
- NewC ->
- {ok, NewC}
+ {lists:reverse(Ids ++ KeepOld),maps:merge(KeepOldDb,Db)}.
+
+update_chsp(#child{id=Id}=OldChild, NewDb) ->
+ case maps:find(Id, NewDb) of
+ {ok,Child} ->
+ {ok,NewDb#{Id => Child#child{pid = OldChild#child.pid}}};
+ error -> % Id not found in new spec.
+ false
end.
+
%%% ---------------------------------------------------
%%% Start a new child.
%%% ---------------------------------------------------
handle_start_child(Child, State) ->
- case get_child(Child#child.name, State) of
- false ->
+ case find_child(Child#child.id, State) of
+ error ->
case do_start_child(State#state.name, Child) of
- {ok, undefined} when Child#child.restart_type =:= temporary ->
+ {ok, undefined} when ?is_temporary(Child) ->
{{ok, undefined}, State};
{ok, Pid} ->
{{ok, Pid}, save_child(Child#child{pid = Pid}, State)};
@@ -731,9 +678,9 @@ handle_start_child(Child, State) ->
{error, What} ->
{{error, {What, Child}}, State}
end;
- {value, OldChild} when is_pid(OldChild#child.pid) ->
+ {ok, OldChild} when is_pid(OldChild#child.pid) ->
{{error, {already_started, OldChild#child.pid}}, State};
- {value, _OldChild} ->
+ {ok, _OldChild} ->
{{error, already_present}, State}
end.
@@ -742,188 +689,157 @@ handle_start_child(Child, State) ->
%%% Returns: {ok, state()} | {shutdown, state()}
%%% ---------------------------------------------------
-restart_child(Pid, Reason, #state{children = [Child]} = State) when ?is_simple(State) ->
- RestartType = Child#child.restart_type,
- case dynamic_child_args(Pid, RestartType, State#state.dynamics) of
- {ok, Args} ->
- {M, F, _} = Child#child.mfargs,
- NChild = Child#child{pid = Pid, mfargs = {M, F, Args}},
- do_restart(RestartType, Reason, NChild, State);
- error ->
- {ok, State}
- end;
-
restart_child(Pid, Reason, State) ->
- Children = State#state.children,
- case lists:keyfind(Pid, #child.pid, Children) of
- #child{restart_type = RestartType} = Child ->
- do_restart(RestartType, Reason, Child, State);
- false ->
+ case find_child_and_args(Pid, State) of
+ {ok, Child} ->
+ do_restart(Reason, Child, State);
+ error ->
{ok, State}
end.
-do_restart(permanent, Reason, Child, State) ->
- report_error(child_terminated, Reason, Child, State#state.name),
+do_restart(Reason, Child, State) when ?is_permanent(Child) ->
+ ?report_error(child_terminated, Reason, Child, State#state.name),
restart(Child, State);
-do_restart(_, normal, Child, State) ->
- NState = state_del_child(Child, State),
+do_restart(normal, Child, State) ->
+ NState = del_child(Child, State),
{ok, NState};
-do_restart(_, shutdown, Child, State) ->
- NState = state_del_child(Child, State),
+do_restart(shutdown, Child, State) ->
+ NState = del_child(Child, State),
{ok, NState};
-do_restart(_, {shutdown, _Term}, Child, State) ->
- NState = state_del_child(Child, State),
+do_restart({shutdown, _Term}, Child, State) ->
+ NState = del_child(Child, State),
{ok, NState};
-do_restart(transient, Reason, Child, State) ->
- report_error(child_terminated, Reason, Child, State#state.name),
+do_restart(Reason, Child, State) when ?is_transient(Child) ->
+ ?report_error(child_terminated, Reason, Child, State#state.name),
restart(Child, State);
-do_restart(temporary, Reason, Child, State) ->
- report_error(child_terminated, Reason, Child, State#state.name),
- NState = state_del_child(Child, State),
+do_restart(Reason, Child, State) when ?is_temporary(Child) ->
+ ?report_error(child_terminated, Reason, Child, State#state.name),
+ NState = del_child(Child, State),
{ok, NState}.
restart(Child, State) ->
case add_restart(State) of
{ok, NState} ->
case restart(NState#state.strategy, Child, NState) of
- {try_again,NState2} ->
+ {{try_again, TryAgainId}, NState2} ->
%% Leaving control back to gen_server before
%% trying again. This way other incoming requsts
%% for the supervisor can be handled - e.g. a
%% shutdown request for the supervisor or the
%% child.
- Id = if ?is_simple(State) -> Child#child.pid;
- true -> Child#child.name
- end,
- ok = try_again_restart(self(), Id),
- {ok,NState2};
- {try_again, NState2, #child{name=ChName}} ->
- ok = try_again_restart(self(), ChName),
+ try_again_restart(TryAgainId),
{ok,NState2};
Other ->
Other
end;
{terminate, NState} ->
- report_error(shutdown, reached_max_restart_intensity,
+ ?report_error(shutdown, reached_max_restart_intensity,
Child, State#state.name),
- {shutdown, remove_child(Child, NState)}
+ {shutdown, del_child(Child, NState)}
end.
restart(simple_one_for_one, Child, State0) ->
#child{pid = OldPid, mfargs = {M, F, A}} = Child,
- State = case OldPid of
+ State1 = case OldPid of
?restarting(_) ->
NRes = State0#state.dynamic_restarts - 1,
State0#state{dynamic_restarts = NRes};
_ ->
State0
end,
- Dynamics = ?DICTS:erase(OldPid, dynamics_db(Child#child.restart_type,
- State#state.dynamics)),
+ State2 = dyn_erase(OldPid, State1),
case do_start_child_i(M, F, A) of
{ok, Pid} ->
- DynamicsDb = {dict, ?DICTS:store(Pid, A, Dynamics)},
- NState = State#state{dynamics = DynamicsDb},
+ NState = dyn_store(Pid, A, State2),
{ok, NState};
{ok, Pid, _Extra} ->
- DynamicsDb = {dict, ?DICTS:store(Pid, A, Dynamics)},
- NState = State#state{dynamics = DynamicsDb},
+ NState = dyn_store(Pid, A, State2),
{ok, NState};
{error, Error} ->
- NRestarts = State#state.dynamic_restarts + 1,
- DynamicsDb = {dict, ?DICTS:store(restarting(OldPid), A, Dynamics)},
- NState = State#state{dynamic_restarts = NRestarts,
- dynamics = DynamicsDb},
- report_error(start_error, Error, Child, State#state.name),
- {try_again, NState}
+ ROldPid = restarting(OldPid),
+ NRestarts = State2#state.dynamic_restarts + 1,
+ State3 = State2#state{dynamic_restarts = NRestarts},
+ NState = dyn_store(ROldPid, A, State3),
+ ?report_error(start_error, Error, Child, NState#state.name),
+ {{try_again, ROldPid}, NState}
end;
-restart(one_for_one, Child, State) ->
+restart(one_for_one, #child{id=Id} = Child, State) ->
OldPid = Child#child.pid,
case do_start_child(State#state.name, Child) of
{ok, Pid} ->
- NState = replace_child(Child#child{pid = Pid}, State),
+ NState = set_pid(Pid, Id, State),
{ok, NState};
{ok, Pid, _Extra} ->
- NState = replace_child(Child#child{pid = Pid}, State),
+ NState = set_pid(Pid, Id, State),
{ok, NState};
{error, Reason} ->
- NState = replace_child(Child#child{pid = restarting(OldPid)}, State),
- report_error(start_error, Reason, Child, State#state.name),
- {try_again, NState}
+ NState = set_pid(restarting(OldPid), Id, State),
+ ?report_error(start_error, Reason, Child, State#state.name),
+ {{try_again,Id}, NState}
end;
-restart(rest_for_one, Child, State) ->
- {ChAfter, ChBefore} = split_child(Child#child.pid, State#state.children),
- ChAfter2 = terminate_children(ChAfter, State#state.name),
- case start_children(ChAfter2, State#state.name) of
- {ok, ChAfter3} ->
- {ok, State#state{children = ChAfter3 ++ ChBefore}};
- {error, ChAfter3, {failed_to_start_child, ChName, _Reason}}
- when ChName =:= Child#child.name ->
- NChild = Child#child{pid=restarting(Child#child.pid)},
- NState = State#state{children = ChAfter3 ++ ChBefore},
- {try_again, replace_child(NChild,NState)};
- {error, ChAfter3, {failed_to_start_child, ChName, _Reason}} ->
- NChild = lists:keyfind(ChName, #child.name, ChAfter3),
- NChild2 = NChild#child{pid=?restarting(undefined)},
- NState = State#state{children = ChAfter3 ++ ChBefore},
- {try_again, replace_child(NChild2,NState), NChild2}
- end;
-restart(one_for_all, Child, State) ->
- Children1 = del_child(Child#child.pid, State#state.children),
- Children2 = terminate_children(Children1, State#state.name),
- case start_children(Children2, State#state.name) of
- {ok, NChs} ->
- {ok, State#state{children = NChs}};
- {error, NChs, {failed_to_start_child, ChName, _Reason}}
- when ChName =:= Child#child.name ->
- NChild = Child#child{pid=restarting(Child#child.pid)},
- NState = State#state{children = NChs},
- {try_again, replace_child(NChild,NState)};
- {error, NChs, {failed_to_start_child, ChName, _Reason}} ->
- NChild = lists:keyfind(ChName, #child.name, NChs),
- NChild2 = NChild#child{pid=?restarting(undefined)},
- NState = State#state{children = NChs},
- {try_again, replace_child(NChild2,NState), NChild2}
+restart(rest_for_one, #child{id=Id} = Child, #state{name=SupName} = State) ->
+ {ChAfter, ChBefore} = split_child(Id, State#state.children),
+ {Return, ChAfter2} = restart_multiple_children(Child, ChAfter, SupName),
+ {Return, State#state{children = append(ChAfter2,ChBefore)}};
+restart(one_for_all, Child, #state{name=SupName} = State) ->
+ Children1 = del_child(Child#child.id, State#state.children),
+ {Return, NChildren} = restart_multiple_children(Child, Children1, SupName),
+ {Return, State#state{children = NChildren}}.
+
+restart_multiple_children(Child, Children, SupName) ->
+ Children1 = terminate_children(Children, SupName),
+ case start_children(Children1, SupName) of
+ {ok, NChildren} ->
+ {ok, NChildren};
+ {error, NChildren, {failed_to_start_child, FailedId, _Reason}} ->
+ NewPid = if FailedId =:= Child#child.id ->
+ restarting(Child#child.pid);
+ true ->
+ ?restarting(undefined)
+ end,
+ {{try_again, FailedId}, set_pid(NewPid,FailedId,NChildren)}
end.
restarting(Pid) when is_pid(Pid) -> ?restarting(Pid);
restarting(RPid) -> RPid.
+-spec try_again_restart(child_id() | {'restarting',pid()}) -> 'ok'.
+try_again_restart(TryAgainId) ->
+ gen_server:cast(self(), {try_again_restart, TryAgainId}).
+
%%-----------------------------------------------------------------
%% Func: terminate_children/2
-%% Args: Children = [child_rec()] in termination order
+%% Args: Children = children() % Ids in termination order
%% SupName = {local, atom()} | {global, atom()} | {pid(),Mod}
-%% Returns: NChildren = [child_rec()] in
-%% startup order (reversed termination order)
+%% Returns: NChildren = children() % Ids in startup order
+%% % (reversed termination order)
%%-----------------------------------------------------------------
terminate_children(Children, SupName) ->
- terminate_children(Children, SupName, []).
-
-%% Temporary children should not be restarted and thus should
-%% be skipped when building the list of terminated children, although
-%% we do want them to be shut down as many functions from this module
-%% use this function to just clear everything.
-terminate_children([Child = #child{restart_type=temporary} | Children], SupName, Res) ->
- _ = do_terminate(Child, SupName),
- terminate_children(Children, SupName, Res);
-terminate_children([Child | Children], SupName, Res) ->
- NChild = do_terminate(Child, SupName),
- terminate_children(Children, SupName, [NChild | Res]);
-terminate_children([], _SupName, Res) ->
- Res.
+ Terminate =
+ fun(_Id,Child) when ?is_temporary(Child) ->
+ %% Temporary children should not be restarted and thus should
+ %% be skipped when building the list of terminated children.
+ do_terminate(Child, SupName),
+ remove;
+ (_Id,Child) ->
+ do_terminate(Child, SupName),
+ {update,Child#child{pid=undefined}}
+ end,
+ {ok,NChildren} = children_map(Terminate, Children),
+ NChildren.
do_terminate(Child, SupName) when is_pid(Child#child.pid) ->
case shutdown(Child#child.pid, Child#child.shutdown) of
ok ->
ok;
- {error, normal} when Child#child.restart_type =/= permanent ->
+ {error, normal} when not (?is_permanent(Child)) ->
ok;
{error, OtherReason} ->
- report_error(shutdown_error, OtherReason, Child, SupName)
+ ?report_error(shutdown_error, OtherReason, Child, SupName)
end,
- Child#child{pid = undefined};
-do_terminate(Child, _SupName) ->
- Child#child{pid = undefined}.
+ ok;
+do_terminate(_Child, _SupName) ->
+ ok.
%%-----------------------------------------------------------------
%% Shutdowns a child. We must check the EXIT value
@@ -996,66 +912,50 @@ monitor_child(Pid) ->
ok
end.
-
%%-----------------------------------------------------------------
-%% Func: terminate_dynamic_children/3
-%% Args: Child = child_rec()
-%% Dynamics = ?DICT() | ?SET()
-%% SupName = {local, atom()} | {global, atom()} | {pid(),Mod}
+%% Func: terminate_dynamic_children/1
+%% Args: State
%% Returns: ok
%%
-%%
%% Shutdown all dynamic children. This happens when the supervisor is
%% stopped. Because the supervisor can have millions of dynamic children, we
-%% can have an significative overhead here.
+%% can have a significative overhead here.
%%-----------------------------------------------------------------
-terminate_dynamic_children(Child, Dynamics, SupName) ->
- {Pids, EStack0} = monitor_dynamic_children(Child, Dynamics),
- Sz = ?SETS:size(Pids),
+terminate_dynamic_children(State) ->
+ Child = get_dynamic_child(State),
+ {Pids, EStack0} = monitor_dynamic_children(Child,State),
+ Sz = sets:size(Pids),
EStack = case Child#child.shutdown of
brutal_kill ->
- ?SETS:fold(fun(P, _) -> exit(P, kill) end, ok, Pids),
+ sets:fold(fun(P, _) -> exit(P, kill) end, ok, Pids),
wait_dynamic_children(Child, Pids, Sz, undefined, EStack0);
infinity ->
- ?SETS:fold(fun(P, _) -> exit(P, shutdown) end, ok, Pids),
+ sets:fold(fun(P, _) -> exit(P, shutdown) end, ok, Pids),
wait_dynamic_children(Child, Pids, Sz, undefined, EStack0);
Time ->
- ?SETS:fold(fun(P, _) -> exit(P, shutdown) end, ok, Pids),
+ sets:fold(fun(P, _) -> exit(P, shutdown) end, ok, Pids),
TRef = erlang:start_timer(Time, self(), kill),
wait_dynamic_children(Child, Pids, Sz, TRef, EStack0)
end,
%% Unroll stacked errors and report them
- ?DICTS:fold(fun(Reason, Ls, _) ->
- report_error(shutdown_error, Reason,
- Child#child{pid=Ls}, SupName)
- end, ok, EStack).
-
-
-monitor_dynamic_children(#child{restart_type=temporary}, Dynamics) ->
- ?SETS:fold(fun(P, {Pids, EStack}) ->
- case monitor_child(P) of
- ok ->
- {?SETS:add_element(P, Pids), EStack};
- {error, normal} ->
- {Pids, EStack};
- {error, Reason} ->
- {Pids, ?DICTS:append(Reason, P, EStack)}
- end
- end, {?SETS:new(), ?DICTS:new()}, Dynamics);
-monitor_dynamic_children(#child{restart_type=RType}, Dynamics) ->
- ?DICTS:fold(fun(P, _, {Pids, EStack}) when is_pid(P) ->
- case monitor_child(P) of
- ok ->
- {?SETS:add_element(P, Pids), EStack};
- {error, normal} when RType =/= permanent ->
- {Pids, EStack};
- {error, Reason} ->
- {Pids, ?DICTS:append(Reason, P, EStack)}
- end;
- (?restarting(_), _, {Pids, EStack}) ->
- {Pids, EStack}
- end, {?SETS:new(), ?DICTS:new()}, Dynamics).
-
+ dict:fold(fun(Reason, Ls, _) ->
+ ?report_error(shutdown_error, Reason,
+ Child#child{pid=Ls}, State#state.name)
+ end, ok, EStack).
+
+monitor_dynamic_children(Child,State) ->
+ dyn_fold(fun(P,{Pids, EStack}) when is_pid(P) ->
+ case monitor_child(P) of
+ ok ->
+ {sets:add_element(P, Pids), EStack};
+ {error, normal} when not (?is_permanent(Child)) ->
+ {Pids, EStack};
+ {error, Reason} ->
+ {Pids, dict:append(Reason, P, EStack)}
+ end;
+ (?restarting(_), {Pids, EStack}) ->
+ {Pids, EStack}
+ end, {sets:new(), dict:new()}, State).
wait_dynamic_children(_Child, _Pids, 0, undefined, EStack) ->
EStack;
@@ -1073,39 +973,38 @@ wait_dynamic_children(#child{shutdown=brutal_kill} = Child, Pids, Sz,
TRef, EStack) ->
receive
{'DOWN', _MRef, process, Pid, killed} ->
- wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1,
+ wait_dynamic_children(Child, sets:del_element(Pid, Pids), Sz-1,
TRef, EStack);
{'DOWN', _MRef, process, Pid, Reason} ->
- wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1,
- TRef, ?DICTS:append(Reason, Pid, EStack))
+ wait_dynamic_children(Child, sets:del_element(Pid, Pids), Sz-1,
+ TRef, dict:append(Reason, Pid, EStack))
end;
-wait_dynamic_children(#child{restart_type=RType} = Child, Pids, Sz,
- TRef, EStack) ->
+wait_dynamic_children(Child, Pids, Sz, TRef, EStack) ->
receive
{'DOWN', _MRef, process, Pid, shutdown} ->
- wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1,
+ wait_dynamic_children(Child, sets:del_element(Pid, Pids), Sz-1,
TRef, EStack);
{'DOWN', _MRef, process, Pid, {shutdown, _}} ->
- wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1,
+ wait_dynamic_children(Child, sets:del_element(Pid, Pids), Sz-1,
TRef, EStack);
- {'DOWN', _MRef, process, Pid, normal} when RType =/= permanent ->
- wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1,
+ {'DOWN', _MRef, process, Pid, normal} when not (?is_permanent(Child)) ->
+ wait_dynamic_children(Child, sets:del_element(Pid, Pids), Sz-1,
TRef, EStack);
{'DOWN', _MRef, process, Pid, Reason} ->
- wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1,
- TRef, ?DICTS:append(Reason, Pid, EStack));
+ wait_dynamic_children(Child, sets:del_element(Pid, Pids), Sz-1,
+ TRef, dict:append(Reason, Pid, EStack));
{timeout, TRef, kill} ->
- ?SETS:fold(fun(P, _) -> exit(P, kill) end, ok, Pids),
+ sets:fold(fun(P, _) -> exit(P, kill) end, ok, Pids),
wait_dynamic_children(Child, Pids, Sz, undefined, EStack)
end.
%%-----------------------------------------------------------------
-%% Child/State manipulating functions.
+%% Access #state.children
%%-----------------------------------------------------------------
%% Note we do not want to save the parameter list for temporary processes as
@@ -1113,114 +1012,184 @@ wait_dynamic_children(#child{restart_type=RType} = Child, Pids, Sz,
%% Especially for dynamic children to simple_one_for_one supervisors
%% it could become very costly as it is not uncommon to spawn
%% very many such processes.
-save_child(#child{restart_type = temporary,
- mfargs = {M, F, _}} = Child, #state{children = Children} = State) ->
- State#state{children = [Child#child{mfargs = {M, F, undefined}} |Children]};
-save_child(Child, #state{children = Children} = State) ->
- State#state{children = [Child |Children]}.
-
-save_dynamic_child(temporary, Pid, _, #state{dynamics = Dynamics} = State) ->
- DynamicsDb = dynamics_db(temporary, Dynamics),
- State#state{dynamics = {set, ?SETS:add_element(Pid, DynamicsDb)}};
-save_dynamic_child(RestartType, Pid, Args, #state{dynamics = Dynamics} = State) ->
- DynamicsDb = dynamics_db(RestartType, Dynamics),
- State#state{dynamics = {dict, ?DICTS:store(Pid, Args, DynamicsDb)}}.
-
-dynamics_db(temporary, undefined) ->
- ?SETS:new();
-dynamics_db(_, undefined) ->
- ?DICTS:new();
-dynamics_db(_, {_Tag, DynamicsDb}) ->
- DynamicsDb.
-
-dynamic_child_args(_Pid, temporary, _DynamicsDb) ->
- {ok, undefined};
-dynamic_child_args(Pid, _RT, {dict, DynamicsDb}) ->
- ?DICTS:find(Pid, DynamicsDb);
-dynamic_child_args(_Pid, _RT, undefined) ->
- error.
-
-state_del_child(#child{pid = Pid, restart_type = temporary}, State) when ?is_simple(State) ->
- NDynamics = ?SETS:del_element(Pid, dynamics_db(temporary, State#state.dynamics)),
- State#state{dynamics = {set, NDynamics}};
-state_del_child(#child{pid = Pid, restart_type = RType}, State) when ?is_simple(State) ->
- NDynamics = ?DICTS:erase(Pid, dynamics_db(RType, State#state.dynamics)),
- State#state{dynamics = {dict, NDynamics}};
-state_del_child(Child, State) ->
- NChildren = del_child(Child#child.name, State#state.children),
- State#state{children = NChildren}.
-
-del_child(Name, [Ch|Chs]) when Ch#child.name =:= Name, Ch#child.restart_type =:= temporary ->
- Chs;
-del_child(Name, [Ch|Chs]) when Ch#child.name =:= Name ->
- [Ch#child{pid = undefined} | Chs];
-del_child(Pid, [Ch|Chs]) when Ch#child.pid =:= Pid, Ch#child.restart_type =:= temporary ->
- Chs;
-del_child(Pid, [Ch|Chs]) when Ch#child.pid =:= Pid ->
- [Ch#child{pid = undefined} | Chs];
-del_child(Name, [Ch|Chs]) ->
- [Ch|del_child(Name, Chs)];
-del_child(_, []) ->
- [].
+-spec save_child(child_rec(), state()) -> state().
+save_child(#child{mfargs = {M, F, _}} = Child, State) when ?is_temporary(Child) ->
+ do_save_child(Child#child{mfargs = {M, F, undefined}}, State);
+save_child(Child, State) ->
+ do_save_child(Child, State).
+
+-spec do_save_child(child_rec(), state()) -> state().
+do_save_child(#child{id = Id} = Child, #state{children = {Ids,Db}} = State) ->
+ State#state{children = {[Id|Ids],Db#{Id => Child}}}.
+
+-spec del_child(child_rec(), state()) -> state();
+ (child_id(), children()) -> children().
+del_child(#child{pid = Pid}, State) when ?is_simple(State) ->
+ dyn_erase(Pid,State);
+del_child(Child, State) when is_record(Child,child), is_record(State,state) ->
+ NChildren = del_child(Child#child.id, State#state.children),
+ State#state{children = NChildren};
+del_child(Id, {Ids,Db}) ->
+ case maps:get(Id, Db) of
+ Child when Child#child.restart_type =:= temporary ->
+ {lists:delete(Id, Ids), maps:remove(Id, Db)};
+ Child ->
+ {Ids, Db#{Id=>Child#child{pid=undefined}}}
+ end.
-%% Chs = [S4, S3, Ch, S1, S0]
-%% Ret: {[S4, S3, Ch], [S1, S0]}
-split_child(Name, Chs) ->
- split_child(Name, Chs, []).
-
-split_child(Name, [Ch|Chs], After) when Ch#child.name =:= Name ->
- {lists:reverse([Ch#child{pid = undefined} | After]), Chs};
-split_child(Pid, [Ch|Chs], After) when Ch#child.pid =:= Pid ->
- {lists:reverse([Ch#child{pid = undefined} | After]), Chs};
-split_child(Name, [Ch|Chs], After) ->
- split_child(Name, Chs, [Ch | After]);
-split_child(_, [], After) ->
- {lists:reverse(After), []}.
-
-get_child(Name, State) ->
- get_child(Name, State, false).
-
-get_child(Pid, State, AllowPid) when AllowPid, is_pid(Pid) ->
- get_dynamic_child(Pid, State);
-get_child(Name, State, _) ->
- lists:keysearch(Name, #child.name, State#state.children).
-
-get_dynamic_child(Pid, #state{children=[Child], dynamics=Dynamics}) ->
- case is_dynamic_pid(Pid, Dynamics) of
- true ->
- {value, Child#child{pid=Pid}};
- false ->
- RPid = restarting(Pid),
- case is_dynamic_pid(RPid, Dynamics) of
- true ->
- {value, Child#child{pid=RPid}};
- false ->
+%% In: {[S4, S3, Ch, S1, S0],Db}
+%% Ret: {{[S4, S3, Ch],Db1}, {[S1, S0],Db2}}
+%% Db1 and Db2 contain the keys in the lists they are associated with.
+-spec split_child(child_id(), children()) -> {children(), children()}.
+split_child(Id, {Ids,Db}) ->
+ {IdsAfter,IdsBefore} = split_ids(Id, Ids, []),
+ DbBefore = maps:with(IdsBefore,Db),
+ #{Id:=Ch} = DbAfter = maps:with(IdsAfter,Db),
+ {{IdsAfter,DbAfter#{Id=>Ch#child{pid=undefined}}},{IdsBefore,DbBefore}}.
+
+split_ids(Id, [Id|Ids], After) ->
+ {lists:reverse([Id|After]), Ids};
+split_ids(Id, [Other|Ids], After) ->
+ split_ids(Id, Ids, [Other | After]).
+
+%% Find the child record for a given Pid (dynamic child) or Id
+%% (non-dynamic child). This is called from the API functions.
+-spec find_child(pid() | child_id(), state()) -> {ok,child_rec()} | error.
+find_child(Pid, State) when is_pid(Pid), ?is_simple(State) ->
+ case find_dynamic_child(Pid, State) of
+ error ->
+ case find_dynamic_child(restarting(Pid), State) of
+ error ->
case erlang:is_process_alive(Pid) of
- true -> false;
- false -> {value, Child}
- end
- end
+ true -> error;
+ false -> {ok, get_dynamic_child(State)}
+ end;
+ Other ->
+ Other
+ end;
+ Other ->
+ Other
+ end;
+find_child(Id, #state{children = {_Ids,Db}}) ->
+ maps:find(Id, Db).
+
+%% Get the child record - either by child id or by pid. If
+%% simple_one_for_one, then insert the pid and args into the returned
+%% child record. This is called when trying to restart the child.
+-spec find_child_and_args(IdOrPid, state()) -> {ok, child_rec()} | error when
+ IdOrPid :: pid() | {restarting,pid()} | child_id().
+find_child_and_args(Pid, State) when ?is_simple(State) ->
+ case find_dynamic_child(Pid, State) of
+ {ok,#child{mfargs={M,F,_}} = Child} ->
+ {ok, Args} = dyn_args(Pid, State),
+ {ok, Child#child{mfargs = {M, F, Args}}};
+ error ->
+ error
+ end;
+find_child_and_args(Pid, State) when is_pid(Pid) ->
+ find_child_by_pid(Pid, State);
+find_child_and_args(Id, #state{children={_Ids,Db}}) ->
+ maps:find(Id, Db).
+
+%% Given the pid, find the child record for a dynamic child, and
+%% include the pid in the returned record.
+-spec find_dynamic_child(IdOrPid, state()) -> {ok, child_rec()} | error when
+ IdOrPid :: pid() | {restarting,pid()} | child_id().
+find_dynamic_child(Pid, State) ->
+ case dyn_exists(Pid, State) of
+ true ->
+ Child = get_dynamic_child(State),
+ {ok, Child#child{pid=Pid}};
+ false ->
+ error
end.
-is_dynamic_pid(Pid, {dict, Dynamics}) ->
- ?DICTS:is_key(Pid, Dynamics);
-is_dynamic_pid(Pid, {set, Dynamics}) ->
- ?SETS:is_element(Pid, Dynamics);
-is_dynamic_pid(_Pid, undefined) ->
- false.
-
-replace_child(Child, State) ->
- Chs = do_replace_child(Child, State#state.children),
- State#state{children = Chs}.
-
-do_replace_child(Child, [Ch|Chs]) when Ch#child.name =:= Child#child.name ->
- [Child | Chs];
-do_replace_child(Child, [Ch|Chs]) ->
- [Ch|do_replace_child(Child, Chs)].
+%% Given the pid, find the child record for a non-dyanamic child.
+-spec find_child_by_pid(IdOrPid, state()) -> {ok,child_rec()} | error when
+ IdOrPid :: pid() | {restarting,pid()}.
+find_child_by_pid(Pid,#state{children={_Ids,Db}}) ->
+ Fun = fun(_Id,#child{pid=P}=Ch,_) when P =:= Pid ->
+ throw(Ch);
+ (_,_,error) ->
+ error
+ end,
+ try maps:fold(Fun,error,Db)
+ catch throw:Child -> {ok,Child}
+ end.
-remove_child(Child, State) ->
- Chs = lists:keydelete(Child#child.name, #child.name, State#state.children),
- State#state{children = Chs}.
+%% Get the child record from a simple_one_for_one supervisor - no pid
+%% It is assumed that the child can always be found
+-spec get_dynamic_child(state()) -> child_rec().
+get_dynamic_child(#state{children={[Id],Db}}) ->
+ #{Id := Child} = Db,
+ Child.
+
+%% Update pid in the given child record and store it in the process state
+-spec set_pid(term(), child_id(), state()) -> state();
+ (term(), child_id(), children()) -> children().
+set_pid(Pid, Id, #state{children=Children} = State) ->
+ State#state{children = set_pid(Pid, Id, Children)};
+set_pid(Pid, Id, {Ids, Db}) ->
+ NewDb = maps:update_with(Id, fun(Child) -> Child#child{pid=Pid} end, Db),
+ {Ids,NewDb}.
+
+%% Remove the Id and the child record from the process state
+-spec remove_child(child_id(), state()) -> state().
+remove_child(Id, #state{children={Ids,Db}} = State) ->
+ NewIds = lists:delete(Id,Ids),
+ NewDb = maps:remove(Id,Db),
+ State#state{children = {NewIds,NewDb}}.
+
+%% In the order of Ids, traverse the children and update each child
+%% according to the return value of the Fun.
+%% On error, abort and return the merge of the old and the updated map.
+%% NOTE: The returned list of Ids is reverted compared to the input.
+-spec children_map(Fun, children()) -> {ok, children()} |
+ {error,children(),Reason} when
+ Fun :: fun((child_id(),child_rec()) -> {update,child_rec()} |
+ remove |
+ {abort, Reason}),
+ Reason :: term().
+children_map(Fun,{Ids,Db}) ->
+ children_map(Fun, Ids, Db, []).
+
+children_map(Fun,[Id|Ids],Db,Acc) ->
+ case Fun(Id,maps:get(Id,Db)) of
+ {update,Child} ->
+ children_map(Fun,Ids,Db#{Id => Child},[Id|Acc]);
+ remove ->
+ children_map(Fun,Ids,maps:remove(Id,Db),Acc);
+ {abort,Reason} ->
+ {error,{lists:reverse(Ids)++[Id|Acc],Db},Reason}
+ end;
+children_map(_Fun,[],Db,Acc) ->
+ {ok,{Acc,Db}}.
+
+%% In the order of Ids, map over all children and return the list
+-spec children_to_list(Fun, children()) -> List when
+ Fun :: fun((child_id(), child_rec()) -> Elem),
+ List :: list(Elem),
+ Elem :: term().
+children_to_list(Fun,{Ids,Db}) ->
+ children_to_list(Fun, Ids, Db, []).
+children_to_list(Fun,[Id|Ids],Db,Acc) ->
+ children_to_list(Fun,Ids,Db,[Fun(Id,maps:get(Id,Db))|Acc]);
+children_to_list(_Fun,[],_Db,Acc) ->
+ lists:reverse(Acc).
+
+%% The order is not important - so ignore Ids
+-spec children_fold(Fun, Acc0, children()) -> Acc1 when
+ Fun :: fun((child_id(), child_rec(), AccIn) -> AccOut),
+ Acc0 :: term(),
+ Acc1 :: term(),
+ AccIn :: term(),
+ AccOut :: term().
+children_fold(Fun,Init,{_Ids,Db}) ->
+ maps:fold(Fun, Init, Db).
+
+-spec append(children(), children()) -> children().
+append({Ids1,Db1},{Ids2,Db2}) ->
+ {Ids1++Ids2,maps:merge(Db1,Db2)}.
%%-----------------------------------------------------------------
%% Func: init_state/4
@@ -1290,27 +1259,27 @@ supname(N, _) -> N.
%%% Returns: {ok, [child_rec()]} | Error
%%% ------------------------------------------------------
-check_startspec(Children) -> check_startspec(Children, []).
+check_startspec(Children) -> check_startspec(Children, [], #{}).
-check_startspec([ChildSpec|T], Res) ->
+check_startspec([ChildSpec|T], Ids, Db) ->
case check_childspec(ChildSpec) of
- {ok, Child} ->
- case lists:keymember(Child#child.name, #child.name, Res) of
+ {ok, #child{id=Id}=Child} ->
+ case maps:is_key(Id, Db) of
%% The error message duplicate_child_name is kept for
%% backwards compatibility, although
%% duplicate_child_id would be more correct.
- true -> {duplicate_child_name, Child#child.name};
- false -> check_startspec(T, [Child | Res])
+ true -> {duplicate_child_name, Id};
+ false -> check_startspec(T, [Id | Ids], Db#{Id=>Child})
end;
Error -> Error
end;
-check_startspec([], Res) ->
- {ok, lists:reverse(Res)}.
+check_startspec([], Ids, Db) ->
+ {ok, {lists:reverse(Ids),Db}}.
check_childspec(ChildSpec) when is_map(ChildSpec) ->
catch do_check_childspec(maps:merge(?default_child_spec,ChildSpec));
-check_childspec({Name, Func, RestartType, Shutdown, ChildType, Mods}) ->
- check_childspec(#{id => Name,
+check_childspec({Id, Func, RestartType, Shutdown, ChildType, Mods}) ->
+ check_childspec(#{id => Id,
start => Func,
restart => RestartType,
shutdown => Shutdown,
@@ -1320,15 +1289,15 @@ check_childspec(X) -> {invalid_child_spec, X}.
do_check_childspec(#{restart := RestartType,
type := ChildType} = ChildSpec)->
- Name = case ChildSpec of
- #{id := N} -> N;
+ Id = case ChildSpec of
+ #{id := I} -> I;
_ -> throw(missing_id)
end,
Func = case ChildSpec of
#{start := F} -> F;
_ -> throw(missing_start)
end,
- validName(Name),
+ validId(Id),
validFunc(Func),
validRestartType(RestartType),
validChildType(ChildType),
@@ -1343,14 +1312,14 @@ do_check_childspec(#{restart := RestartType,
_ -> {M,_,_} = Func, [M]
end,
validMods(Mods),
- {ok, #child{name = Name, mfargs = Func, restart_type = RestartType,
+ {ok, #child{id = Id, mfargs = Func, restart_type = RestartType,
shutdown = Shutdown, child_type = ChildType, modules = Mods}}.
validChildType(supervisor) -> true;
validChildType(worker) -> true;
validChildType(What) -> throw({invalid_child_type, What}).
-validName(_Name) -> true.
+validId(_Id) -> true.
validFunc({M, F, A}) when is_atom(M),
is_atom(F),
@@ -1379,13 +1348,13 @@ validMods(Mods) when is_list(Mods) ->
Mods);
validMods(Mods) -> throw({invalid_modules, Mods}).
-child_to_spec(#child{name = Name,
+child_to_spec(#child{id = Id,
mfargs = Func,
restart_type = RestartType,
shutdown = Shutdown,
child_type = ChildType,
modules = Mods}) ->
- #{id => Name,
+ #{id => Id,
start => Func,
restart => RestartType,
shutdown => Shutdown,
@@ -1431,37 +1400,75 @@ inPeriod(Then, Now, Period) ->
%%% ------------------------------------------------------
%%% Error and progress reporting.
%%% ------------------------------------------------------
-
-report_error(Error, Reason, Child, SupName) ->
- ErrorMsg = [{supervisor, SupName},
- {errorContext, Error},
- {reason, Reason},
- {offender, extract_child(Child)}],
- error_logger:error_report(supervisor_report, ErrorMsg).
-
-
extract_child(Child) when is_list(Child#child.pid) ->
[{nb_children, length(Child#child.pid)},
- {id, Child#child.name},
+ {id, Child#child.id},
{mfargs, Child#child.mfargs},
{restart_type, Child#child.restart_type},
{shutdown, Child#child.shutdown},
{child_type, Child#child.child_type}];
extract_child(Child) ->
[{pid, Child#child.pid},
- {id, Child#child.name},
+ {id, Child#child.id},
{mfargs, Child#child.mfargs},
{restart_type, Child#child.restart_type},
{shutdown, Child#child.shutdown},
{child_type, Child#child.child_type}].
report_progress(Child, SupName) ->
- Progress = [{supervisor, SupName},
- {started, extract_child(Child)}],
- error_logger:info_report(progress, Progress).
+ ?LOG_INFO(#{label=>{supervisor,progress},
+ report=>[{supervisor,SupName},
+ {started,extract_child(Child)}]},
+ #{domain=>[otp,sasl],
+ report_cb=>fun logger:format_otp_report/1,
+ logger_formatter=>#{title=>"PROGRESS REPORT"},
+ error_logger=>#{tag=>info_report,type=>progress}}).
format_status(terminate, [_PDict, State]) ->
State;
format_status(_, [_PDict, State]) ->
[{data, [{"State", State}]},
{supervisor, [{"Callback", State#state.module}]}].
+
+%%%-----------------------------------------------------------------
+%%% Dynamics database access
+dyn_size(#state{dynamics = {Mod,Db}}) ->
+ Mod:size(Db).
+
+dyn_erase(Pid,#state{dynamics={sets,Db}}=State) ->
+ State#state{dynamics={sets,sets:del_element(Pid,Db)}};
+dyn_erase(Pid,#state{dynamics={maps,Db}}=State) ->
+ State#state{dynamics={maps,maps:remove(Pid,Db)}}.
+
+dyn_store(Pid,_,#state{dynamics={sets,Db}}=State) ->
+ State#state{dynamics={sets,sets:add_element(Pid,Db)}};
+dyn_store(Pid,Args,#state{dynamics={maps,Db}}=State) ->
+ State#state{dynamics={maps,Db#{Pid => Args}}}.
+
+dyn_fold(Fun,Init,#state{dynamics={sets,Db}}) ->
+ sets:fold(Fun,Init,Db);
+dyn_fold(Fun,Init,#state{dynamics={maps,Db}}) ->
+ maps:fold(fun(Pid,_,Acc) -> Fun(Pid,Acc) end, Init, Db).
+
+dyn_map(Fun, #state{dynamics={sets,Db}}) ->
+ lists:map(Fun, sets:to_list(Db));
+dyn_map(Fun, #state{dynamics={maps,Db}}) ->
+ lists:map(Fun, maps:keys(Db)).
+
+dyn_exists(Pid, #state{dynamics={sets, Db}}) ->
+ sets:is_element(Pid, Db);
+dyn_exists(Pid, #state{dynamics={maps, Db}}) ->
+ maps:is_key(Pid, Db).
+
+dyn_args(_Pid, #state{dynamics={sets, _Db}}) ->
+ {ok,undefined};
+dyn_args(Pid, #state{dynamics={maps, Db}}) ->
+ maps:find(Pid, Db).
+
+dyn_init(State) ->
+ dyn_init(get_dynamic_child(State),State).
+
+dyn_init(Child,State) when ?is_temporary(Child) ->
+ State#state{dynamics={sets,sets:new()}};
+dyn_init(_Child,State) ->
+ State#state{dynamics={maps,maps:new()}}.
diff --git a/lib/stdlib/src/supervisor_bridge.erl b/lib/stdlib/src/supervisor_bridge.erl
index af1e046d30..21ba6f53af 100644
--- a/lib/stdlib/src/supervisor_bridge.erl
+++ b/lib/stdlib/src/supervisor_bridge.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -21,6 +21,8 @@
-behaviour(gen_server).
+-include("logger.hrl").
+
%% External exports
-export([start_link/2, start_link/3]).
%% Internal exports
@@ -129,13 +131,22 @@ terminate_pid(Reason, #state{mod = Mod, child_state = ChildState}) ->
Mod:terminate(Reason, ChildState).
report_progress(Pid, Mod, StartArgs, SupName) ->
- Progress = [{supervisor, SupName},
- {started, [{pid, Pid}, {mfa, {Mod, init, [StartArgs]}}]}],
- error_logger:info_report(progress, Progress).
+ ?LOG_INFO(#{label=>{supervisor,progress},
+ report=>[{supervisor, SupName},
+ {started, [{pid, Pid},
+ {mfa, {Mod, init, [StartArgs]}}]}]},
+ #{domain=>[otp,sasl],
+ report_cb=>fun logger:format_otp_report/1,
+ logger_formatter=>#{title=>"PROGRESS REPORT"},
+ error_logger=>#{tag=>info_report,type=>progress}}).
report_error(Error, Reason, #state{name = Name, pid = Pid, mod = Mod}) ->
- ErrorMsg = [{supervisor, Name},
- {errorContext, Error},
- {reason, Reason},
- {offender, [{pid, Pid}, {mod, Mod}]}],
- error_logger:error_report(supervisor_report, ErrorMsg).
+ ?LOG_ERROR(#{label=>{supervisor,error},
+ report=>[{supervisor, Name},
+ {errorContext, Error},
+ {reason, Reason},
+ {offender, [{pid, Pid}, {mod, Mod}]}]},
+ #{domain=>[otp,sasl],
+ report_cb=>fun logger:format_otp_report/1,
+ logger_formatter=>#{title=>"SUPERVISOR REPORT"},
+ error_logger=>#{tag=>error_report,type=>supervisor_report}}).
diff --git a/lib/stdlib/src/sys.erl b/lib/stdlib/src/sys.erl
index 0c578acf21..0064414d6f 100644
--- a/lib/stdlib/src/sys.erl
+++ b/lib/stdlib/src/sys.erl
@@ -44,6 +44,7 @@
-type system_event() :: {'in', Msg :: _}
| {'in', Msg :: _, From :: _}
| {'out', Msg :: _, To :: _}
+ | {'out', Msg :: _, To :: _, State :: _}
| term().
-opaque dbg_opt() :: {'trace', 'true'}
| {'log',
@@ -56,7 +57,8 @@
MessagesIn :: non_neg_integer(),
MessagesOut :: non_neg_integer()}}
| {'log_to_file', file:io_device()}
- | {Func :: dbg_fun(), FuncState :: term()}.
+ | {Func :: dbg_fun(), FuncState :: term()}
+ | {FuncId :: term(), Func :: dbg_fun(), FuncState :: term()}.
-type dbg_fun() :: fun((FuncState :: _,
Event :: system_event(),
ProcState :: _) -> 'done' | (NewFuncState :: _)).
@@ -267,33 +269,41 @@ no_debug(Name, Timeout) -> send_system_msg(Name, {debug, no_debug}, Timeout).
-spec install(Name, FuncSpec) -> 'ok' when
Name :: name(),
- FuncSpec :: {Func, FuncState},
+ FuncSpec :: {Func, FuncState} | {FuncId, Func, FuncState},
+ FuncId :: term(),
Func :: dbg_fun(),
FuncState :: term().
install(Name, {Func, FuncState}) ->
- send_system_msg(Name, {debug, {install, {Func, FuncState}}}).
+ send_system_msg(Name, {debug, {install, {Func, FuncState}}});
+install(Name, {FuncId, Func, FuncState}) ->
+ send_system_msg(Name, {debug, {install, {FuncId, Func, FuncState}}}).
-spec install(Name, FuncSpec, Timeout) -> 'ok' when
Name :: name(),
- FuncSpec :: {Func, FuncState},
+ FuncSpec :: {Func, FuncState} | {FuncId, Func, FuncState},
+ FuncId :: term(),
Func :: dbg_fun(),
FuncState :: term(),
Timeout :: timeout().
install(Name, {Func, FuncState}, Timeout) ->
- send_system_msg(Name, {debug, {install, {Func, FuncState}}}, Timeout).
+ send_system_msg(Name, {debug, {install, {Func, FuncState}}}, Timeout);
+install(Name, {FuncId, Func, FuncState}, Timeout) ->
+ send_system_msg(Name, {debug, {install, {FuncId, Func, FuncState}}}, Timeout).
--spec remove(Name, Func) -> 'ok' when
+-spec remove(Name, Func | FuncId) -> 'ok' when
Name :: name(),
- Func :: dbg_fun().
-remove(Name, Func) ->
- send_system_msg(Name, {debug, {remove, Func}}).
+ Func :: dbg_fun(),
+ FuncId :: term().
+remove(Name, FuncOrFuncId) ->
+ send_system_msg(Name, {debug, {remove, FuncOrFuncId}}).
--spec remove(Name, Func, Timeout) -> 'ok' when
+-spec remove(Name, Func | FuncId, Timeout) -> 'ok' when
Name :: name(),
Func :: dbg_fun(),
+ FuncId :: term(),
Timeout :: timeout().
-remove(Name, Func, Timeout) ->
- send_system_msg(Name, {debug, {remove, Func}}, Timeout).
+remove(Name, FuncOrFuncId, Timeout) ->
+ send_system_msg(Name, {debug, {remove, FuncOrFuncId}}, Timeout).
%%-----------------------------------------------------------------
%% All system messages sent are on the form {system, From, Msg}
@@ -387,6 +397,13 @@ handle_debug([{log_to_file, Fd} | T], FormFunc, State, Event) ->
handle_debug([{statistics, StatData} | T], FormFunc, State, Event) ->
NStatData = stat(Event, StatData),
[{statistics, NStatData} | handle_debug(T, FormFunc, State, Event)];
+handle_debug([{FuncId, {Func, FuncState}} | T], FormFunc, State, Event) ->
+ case catch Func(FuncState, Event, State) of
+ done -> handle_debug(T, FormFunc, State, Event);
+ {'EXIT', _} -> handle_debug(T, FormFunc, State, Event);
+ NFuncState ->
+ [{FuncId, {Func, NFuncState}} | handle_debug(T, FormFunc, State, Event)]
+ end;
handle_debug([{Func, FuncState} | T], FormFunc, State, Event) ->
case catch Func(FuncState, Event, State) of
done -> handle_debug(T, FormFunc, State, Event);
@@ -544,8 +561,10 @@ debug_cmd(no_debug, Debug) ->
{ok, []};
debug_cmd({install, {Func, FuncState}}, Debug) ->
{ok, install_debug(Func, FuncState, Debug)};
-debug_cmd({remove, Func}, Debug) ->
- {ok, remove_debug(Func, Debug)};
+debug_cmd({install, {FuncId, Func, FuncState}}, Debug) ->
+ {ok, install_debug(FuncId, {Func, FuncState}, Debug)};
+debug_cmd({remove, FuncOrFuncId}, Debug) ->
+ {ok, remove_debug(FuncOrFuncId, Debug)};
debug_cmd(_Unknown, Debug) ->
{unknown_debug, Debug}.
@@ -573,6 +592,7 @@ get_stat(_) ->
stat({in, _Msg}, {Time, Reds, In, Out}) -> {Time, Reds, In+1, Out};
stat({in, _Msg, _From}, {Time, Reds, In, Out}) -> {Time, Reds, In+1, Out};
stat({out, _Msg, _To}, {Time, Reds, In, Out}) -> {Time, Reds, In, Out+1};
+stat({out, _Msg, _To, _State}, {Time, Reds, In, Out}) -> {Time, Reds, In, Out+1};
stat(_, StatData) -> StatData.
trim(N, LogData) ->
@@ -582,9 +602,9 @@ trim(N, LogData) ->
%% Debug structure manipulating functions
%%-----------------------------------------------------------------
install_debug(Item, Data, Debug) ->
- case get_debug2(Item, Debug, undefined) of
- undefined -> [{Item, Data} | Debug];
- _ -> Debug
+ case lists:keysearch(Item, 1, Debug) of
+ false -> [{Item, Data} | Debug];
+ _ -> Debug
end.
remove_debug(Item, Debug) -> lists:keydelete(Item, 1, Debug).
@@ -635,7 +655,8 @@ close_log_file(Debug) ->
| {'log_to_file', FileName}
| {'install', FuncSpec},
FileName :: file:name(),
- FuncSpec :: {Func, FuncState},
+ FuncSpec :: {Func, FuncState} | {FuncId, Func, FuncState},
+ FuncId :: term(),
Func :: dbg_fun(),
FuncState :: term().
debug_options(Options) ->
@@ -658,6 +679,8 @@ debug_options([{log_to_file, FileName} | T], Debug) ->
end;
debug_options([{install, {Func, FuncState}} | T], Debug) ->
debug_options(T, install_debug(Func, FuncState, Debug));
+debug_options([{install, {FuncId, Func, FuncState}} | T], Debug) ->
+ debug_options(T, install_debug(FuncId, {Func, FuncState}, Debug));
debug_options([_ | T], Debug) ->
debug_options(T, Debug);
debug_options([], Debug) ->
diff --git a/lib/stdlib/src/uri_string.erl b/lib/stdlib/src/uri_string.erl
new file mode 100644
index 0000000000..f07307c039
--- /dev/null
+++ b/lib/stdlib/src/uri_string.erl
@@ -0,0 +1,2148 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017-2018. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%% [RFC 3986, Chapter 2.2. Reserved Characters]
+%%
+%% reserved = gen-delims / sub-delims
+%%
+%% gen-delims = ":" / "/" / "?" / "#" / "[" / "]" / "@"
+%%
+%% sub-delims = "!" / "$" / "&" / "'" / "(" / ")"
+%% / "*" / "+" / "," / ";" / "="
+%%
+%%
+%% [RFC 3986, Chapter 2.3. Unreserved Characters]
+%%
+%% unreserved = ALPHA / DIGIT / "-" / "." / "_" / "~"
+%%
+%%
+%% [RFC 3986, Chapter 3. Syntax Components]
+%%
+%% The generic URI syntax consists of a hierarchical sequence of
+%% components referred to as the scheme, authority, path, query, and
+%% fragment.
+%%
+%% URI = scheme ":" hier-part [ "?" query ] [ "#" fragment ]
+%%
+%% hier-part = "//" authority path-abempty
+%% / path-absolute
+%% / path-rootless
+%% / path-empty
+%%
+%% The scheme and path components are required, though the path may be
+%% empty (no characters). When authority is present, the path must
+%% either be empty or begin with a slash ("/") character. When
+%% authority is not present, the path cannot begin with two slash
+%% characters ("//"). These restrictions result in five different ABNF
+%% rules for a path (Section 3.3), only one of which will match any
+%% given URI reference.
+%%
+%% The following are two example URIs and their component parts:
+%%
+%% foo://example.com:8042/over/there?name=ferret#nose
+%% \_/ \______________/\_________/ \_________/ \__/
+%% | | | | |
+%% scheme authority path query fragment
+%% | _____________________|__
+%% / \ / \
+%% urn:example:animal:ferret:nose
+%%
+%%
+%% [RFC 3986, Chapter 3.1. Scheme]
+%%
+%% Each URI begins with a scheme name that refers to a specification for
+%% assigning identifiers within that scheme.
+%%
+%% scheme = ALPHA *( ALPHA / DIGIT / "+" / "-" / "." )
+%%
+%%
+%% [RFC 3986, Chapter 3.2. Authority]
+%%
+%% Many URI schemes include a hierarchical element for a naming
+%% authority so that governance of the name space defined by the
+%% remainder of the URI is delegated to that authority (which may, in
+%% turn, delegate it further).
+%%
+%% authority = [ userinfo "@" ] host [ ":" port ]
+%%
+%%
+%% [RFC 3986, Chapter 3.2.1. User Information]
+%%
+%% The userinfo subcomponent may consist of a user name and, optionally,
+%% scheme-specific information about how to gain authorization to access
+%% the resource. The user information, if present, is followed by a
+%% commercial at-sign ("@") that delimits it from the host.
+%%
+%% userinfo = *( unreserved / pct-encoded / sub-delims / ":" )
+%%
+%%
+%% [RFC 3986, Chapter 3.2.2. Host]
+%%
+%% The host subcomponent of authority is identified by an IP literal
+%% encapsulated within square brackets, an IPv4 address in dotted-
+%% decimal form, or a registered name.
+%%
+%% host = IP-literal / IPv4address / reg-name
+%%
+%% IP-literal = "[" ( IPv6address / IPvFuture ) "]"
+%%
+%% IPvFuture = "v" 1*HEXDIG "." 1*( unreserved / sub-delims / ":" )
+%%
+%% IPv6address = 6( h16 ":" ) ls32
+%% / "::" 5( h16 ":" ) ls32
+%% / [ h16 ] "::" 4( h16 ":" ) ls32
+%% / [ *1( h16 ":" ) h16 ] "::" 3( h16 ":" ) ls32
+%% / [ *2( h16 ":" ) h16 ] "::" 2( h16 ":" ) ls32
+%% / [ *3( h16 ":" ) h16 ] "::" h16 ":" ls32
+%% / [ *4( h16 ":" ) h16 ] "::" ls32
+%% / [ *5( h16 ":" ) h16 ] "::" h16
+%% / [ *6( h16 ":" ) h16 ] "::"
+%%
+%% ls32 = ( h16 ":" h16 ) / IPv4address
+%% ; least-significant 32 bits of address
+%%
+%% h16 = 1*4HEXDIG
+%% ; 16 bits of address represented in hexadecimal
+%%
+%% IPv4address = dec-octet "." dec-octet "." dec-octet "." dec-octet
+%%
+%% dec-octet = DIGIT ; 0-9
+%% / %x31-39 DIGIT ; 10-99
+%% / "1" 2DIGIT ; 100-199
+%% / "2" %x30-34 DIGIT ; 200-249
+%% / "25" %x30-35 ; 250-255
+%%
+%% reg-name = *( unreserved / pct-encoded / sub-delims )
+%%
+%%
+%% [RFC 3986, Chapter 3.2.2. Port]
+%%
+%% The port subcomponent of authority is designated by an optional port
+%% number in decimal following the host and delimited from it by a
+%% single colon (":") character.
+%%
+%% port = *DIGIT
+%%
+%%
+%% [RFC 3986, Chapter 3.3. Path]
+%%
+%% The path component contains data, usually organized in hierarchical
+%% form, that, along with data in the non-hierarchical query component
+%% (Section 3.4), serves to identify a resource within the scope of the
+%% URI's scheme and naming authority (if any). The path is terminated
+%% by the first question mark ("?") or number sign ("#") character, or
+%% by the end of the URI.
+%%
+%% path = path-abempty ; begins with "/" or is empty
+%% / path-absolute ; begins with "/" but not "//"
+%% / path-noscheme ; begins with a non-colon segment
+%% / path-rootless ; begins with a segment
+%% / path-empty ; zero characters
+%%
+%% path-abempty = *( "/" segment )
+%% path-absolute = "/" [ segment-nz *( "/" segment ) ]
+%% path-noscheme = segment-nz-nc *( "/" segment )
+%% path-rootless = segment-nz *( "/" segment )
+%% path-empty = 0<pchar>
+%% segment = *pchar
+%% segment-nz = 1*pchar
+%% segment-nz-nc = 1*( unreserved / pct-encoded / sub-delims / "@" )
+%% ; non-zero-length segment without any colon ":"
+%%
+%% pchar = unreserved / pct-encoded / sub-delims / ":" / "@"
+%%
+%%
+%% [RFC 3986, Chapter 3.4. Query]
+%%
+%% The query component contains non-hierarchical data that, along with
+%% data in the path component (Section 3.3), serves to identify a
+%% resource within the scope of the URI's scheme and naming authority
+%% (if any). The query component is indicated by the first question
+%% mark ("?") character and terminated by a number sign ("#") character
+%% or by the end of the URI.
+%%
+%% query = *( pchar / "/" / "?" )
+%%
+%%
+%% [RFC 3986, Chapter 3.5. Fragment]
+%%
+%% The fragment identifier component of a URI allows indirect
+%% identification of a secondary resource by reference to a primary
+%% resource and additional identifying information.
+%%
+%% fragment = *( pchar / "/" / "?" )
+%%
+%%
+%% [RFC 3986, Chapter 4.1. URI Reference]
+%%
+%% URI-reference is used to denote the most common usage of a resource
+%% identifier.
+%%
+%% URI-reference = URI / relative-ref
+%%
+%%
+%% [RFC 3986, Chapter 4.2. Relative Reference]
+%%
+%% A relative reference takes advantage of the hierarchical syntax
+%% (Section 1.2.3) to express a URI reference relative to the name space
+%% of another hierarchical URI.
+%%
+%% relative-ref = relative-part [ "?" query ] [ "#" fragment ]
+%%
+%% relative-part = "//" authority path-abempty
+%% / path-absolute
+%% / path-noscheme
+%% / path-empty
+%%
+%%
+%% [RFC 3986, Chapter 4.3. Absolute URI]
+%%
+%% Some protocol elements allow only the absolute form of a URI without
+%% a fragment identifier. For example, defining a base URI for later
+%% use by relative references calls for an absolute-URI syntax rule that
+%% does not allow a fragment.
+%%
+%% absolute-URI = scheme ":" hier-part [ "?" query ]
+%%
+-module(uri_string).
+
+%%-------------------------------------------------------------------------
+%% External API
+%%-------------------------------------------------------------------------
+-export([compose_query/1, compose_query/2,
+ dissect_query/1, normalize/1, normalize/2, parse/1,
+ recompose/1, transcode/2]).
+-export_type([error/0, uri_map/0, uri_string/0]).
+
+
+%%-------------------------------------------------------------------------
+%% Internal API
+%%-------------------------------------------------------------------------
+-export([is_host/1, is_path/1]). % suppress warnings
+
+
+%%-------------------------------------------------------------------------
+%% Macros
+%%-------------------------------------------------------------------------
+-define(CHAR(Char), <<Char/utf8>>).
+-define(STRING_EMPTY, <<>>).
+-define(STRING(MatchStr), <<MatchStr/binary>>).
+-define(STRING_REST(MatchStr, Rest), <<MatchStr/utf8, Rest/binary>>).
+
+-define(DEC2HEX(X),
+ if ((X) >= 0) andalso ((X) =< 9) -> (X) + $0;
+ ((X) >= 10) andalso ((X) =< 15) -> (X) + $A - 10
+ end).
+
+-define(HEX2DEC(X),
+ if ((X) >= $0) andalso ((X) =< $9) -> (X) - $0;
+ ((X) >= $A) andalso ((X) =< $F) -> (X) - $A + 10;
+ ((X) >= $a) andalso ((X) =< $f) -> (X) - $a + 10
+ end).
+
+
+%%%=========================================================================
+%%% API
+%%%=========================================================================
+
+%%-------------------------------------------------------------------------
+%% URI compliant with RFC 3986
+%% ASCII %x21 - %x7A ("!" - "z") except
+%% %x34 " double quote
+%% %x60 < less than
+%% %x62 > greater than
+%% %x92 \ backslash
+%% %x94 ^ caret / circumflex
+%% %x96 ` grave / accent
+%%-------------------------------------------------------------------------
+-type uri_string() :: iodata().
+-type error() :: {error, atom(), term()}.
+
+
+%%-------------------------------------------------------------------------
+%% RFC 3986, Chapter 3. Syntax Components
+%%-------------------------------------------------------------------------
+-type uri_map() ::
+ #{fragment => unicode:chardata(),
+ host => unicode:chardata(),
+ path => unicode:chardata(),
+ port => non_neg_integer() | undefined,
+ query => unicode:chardata(),
+ scheme => unicode:chardata(),
+ userinfo => unicode:chardata()} | #{}.
+
+
+%%-------------------------------------------------------------------------
+%% Normalize URIs
+%%-------------------------------------------------------------------------
+-spec normalize(URI) -> NormalizedURI when
+ URI :: uri_string() | uri_map(),
+ NormalizedURI :: uri_string()
+ | error().
+normalize(URIMap) ->
+ try normalize(URIMap, [])
+ catch
+ throw:{error, Atom, RestData} -> {error, Atom, RestData}
+ end.
+
+
+-spec normalize(URI, Options) -> NormalizedURI when
+ URI :: uri_string() | uri_map(),
+ Options :: [return_map],
+ NormalizedURI :: uri_string() | uri_map().
+normalize(URIMap, []) when is_map(URIMap) ->
+ recompose(normalize_map(URIMap));
+normalize(URIMap, [return_map]) when is_map(URIMap) ->
+ normalize_map(URIMap);
+normalize(URIString, []) ->
+ case parse(URIString) of
+ Value when is_map(Value) ->
+ recompose(normalize_map(Value));
+ Error ->
+ Error
+ end;
+normalize(URIString, [return_map]) ->
+ case parse(URIString) of
+ Value when is_map(Value) ->
+ normalize_map(Value);
+ Error ->
+ Error
+ end.
+
+
+%%-------------------------------------------------------------------------
+%% Parse URIs
+%%-------------------------------------------------------------------------
+-spec parse(URIString) -> URIMap when
+ URIString :: uri_string(),
+ URIMap :: uri_map()
+ | error().
+parse(URIString) when is_binary(URIString) ->
+ try parse_uri_reference(URIString, #{})
+ catch
+ throw:{error, Atom, RestData} -> {error, Atom, RestData}
+ end;
+parse(URIString) when is_list(URIString) ->
+ try
+ Binary = unicode:characters_to_binary(URIString),
+ Map = parse_uri_reference(Binary, #{}),
+ convert_mapfields_to_list(Map)
+ catch
+ throw:{error, Atom, RestData} -> {error, Atom, RestData}
+ end.
+
+
+%%-------------------------------------------------------------------------
+%% Recompose URIs
+%%-------------------------------------------------------------------------
+-spec recompose(URIMap) -> URIString when
+ URIMap :: uri_map(),
+ URIString :: uri_string()
+ | error().
+recompose(Map) ->
+ case is_valid_map(Map) of
+ false ->
+ {error, invalid_map, Map};
+ true ->
+ try
+ T0 = update_scheme(Map, empty),
+ T1 = update_userinfo(Map, T0),
+ T2 = update_host(Map, T1),
+ T3 = update_port(Map, T2),
+ T4 = update_path(Map, T3),
+ T5 = update_query(Map, T4),
+ update_fragment(Map, T5)
+ catch
+ throw:{error, Atom, RestData} -> {error, Atom, RestData}
+ end
+ end.
+
+
+%%-------------------------------------------------------------------------
+%% Transcode URIs
+%%-------------------------------------------------------------------------
+-spec transcode(URIString, Options) -> Result when
+ URIString :: uri_string(),
+ Options :: [{in_encoding, unicode:encoding()}|{out_encoding, unicode:encoding()}],
+ Result :: uri_string()
+ | error().
+transcode(URIString, Options) when is_binary(URIString) ->
+ try
+ InEnc = proplists:get_value(in_encoding, Options, utf8),
+ OutEnc = proplists:get_value(out_encoding, Options, utf8),
+ List = convert_to_list(URIString, InEnc),
+ Output = transcode(List, [], InEnc, OutEnc),
+ convert_to_binary(Output, utf8, OutEnc)
+ catch
+ throw:{error, Atom, RestData} -> {error, Atom, RestData}
+ end;
+transcode(URIString, Options) when is_list(URIString) ->
+ InEnc = proplists:get_value(in_encoding, Options, utf8),
+ OutEnc = proplists:get_value(out_encoding, Options, utf8),
+ Flattened = flatten_list(URIString, InEnc),
+ try transcode(Flattened, [], InEnc, OutEnc)
+ catch
+ throw:{error, Atom, RestData} -> {error, Atom, RestData}
+ end.
+
+
+%%-------------------------------------------------------------------------
+%% Functions for working with the query part of a URI as a list
+%% of key/value pairs.
+%% HTML 5.2 - 4.10.21.6 URL-encoded form data - WHATWG URL (10 Jan 2018) - UTF-8
+%% HTML 5.0 - 4.10.22.6 URL-encoded form data - non UTF-8
+%%-------------------------------------------------------------------------
+
+%%-------------------------------------------------------------------------
+%% Compose urlencoded query string from a list of unescaped key/value pairs.
+%% (application/x-www-form-urlencoded encoding algorithm)
+%%-------------------------------------------------------------------------
+-spec compose_query(QueryList) -> QueryString when
+ QueryList :: [{unicode:chardata(), unicode:chardata()}],
+ QueryString :: uri_string()
+ | error().
+compose_query(List) ->
+ compose_query(List, [{encoding, utf8}]).
+
+
+-spec compose_query(QueryList, Options) -> QueryString when
+ QueryList :: [{unicode:chardata(), unicode:chardata()}],
+ Options :: [{encoding, atom()}],
+ QueryString :: uri_string()
+ | error().
+compose_query([],_Options) ->
+ [];
+compose_query(List, Options) ->
+ try compose_query(List, Options, false, <<>>)
+ catch
+ throw:{error, Atom, RestData} -> {error, Atom, RestData}
+ end.
+%%
+compose_query([{Key,Value}|Rest], Options, IsList, Acc) ->
+ Separator = get_separator(Rest),
+ K = form_urlencode(Key, Options),
+ V = form_urlencode(Value, Options),
+ IsListNew = IsList orelse is_list(Key) orelse is_list(Value),
+ compose_query(Rest, Options, IsListNew, <<Acc/binary,K/binary,"=",V/binary,Separator/binary>>);
+compose_query([], _Options, IsList, Acc) ->
+ case IsList of
+ true -> convert_to_list(Acc, utf8);
+ false -> Acc
+ end.
+
+
+%%-------------------------------------------------------------------------
+%% Dissect a query string into a list of unescaped key/value pairs.
+%% (application/x-www-form-urlencoded decoding algorithm)
+%%-------------------------------------------------------------------------
+-spec dissect_query(QueryString) -> QueryList when
+ QueryString :: uri_string(),
+ QueryList :: [{unicode:chardata(), unicode:chardata()}]
+ | error().
+dissect_query(<<>>) ->
+ [];
+dissect_query([]) ->
+ [];
+dissect_query(QueryString) when is_list(QueryString) ->
+ try
+ B = convert_to_binary(QueryString, utf8, utf8),
+ dissect_query_key(B, true, [], <<>>, <<>>)
+ catch
+ throw:{error, Atom, RestData} -> {error, Atom, RestData}
+ end;
+dissect_query(QueryString) ->
+ try dissect_query_key(QueryString, false, [], <<>>, <<>>)
+ catch
+ throw:{error, Atom, RestData} -> {error, Atom, RestData}
+ end.
+
+
+%%%========================================================================
+%%% Internal functions
+%%%========================================================================
+
+%%-------------------------------------------------------------------------
+%% Converts Map fields to lists
+%%-------------------------------------------------------------------------
+convert_mapfields_to_list(Map) ->
+ Fun = fun (_, V) when is_binary(V) -> unicode:characters_to_list(V);
+ (_, V) -> V end,
+ maps:map(Fun, Map).
+
+
+%%-------------------------------------------------------------------------
+%% [RFC 3986, Chapter 4.1. URI Reference]
+%%
+%% URI-reference is used to denote the most common usage of a resource
+%% identifier.
+%%
+%% URI-reference = URI / relative-ref
+%%-------------------------------------------------------------------------
+-spec parse_uri_reference(binary(), uri_map()) -> uri_map().
+parse_uri_reference(<<>>, _) -> #{path => <<>>};
+parse_uri_reference(URIString, URI) ->
+ try parse_scheme_start(URIString, URI)
+ catch
+ throw:{_,_,_} ->
+ parse_relative_part(URIString, URI)
+ end.
+
+
+%%-------------------------------------------------------------------------
+%% [RFC 3986, Chapter 4.2. Relative Reference]
+%%
+%% A relative reference takes advantage of the hierarchical syntax
+%% (Section 1.2.3) to express a URI reference relative to the name space
+%% of another hierarchical URI.
+%%
+%% relative-ref = relative-part [ "?" query ] [ "#" fragment ]
+%%
+%% relative-part = "//" authority path-abempty
+%% / path-absolute
+%% / path-noscheme
+%% / path-empty
+%%-------------------------------------------------------------------------
+-spec parse_relative_part(binary(), uri_map()) -> uri_map().
+parse_relative_part(?STRING_REST("//", Rest), URI) ->
+ %% Parse userinfo - "//" is NOT part of authority
+ try parse_userinfo(Rest, URI) of
+ {T, URI1} ->
+ Userinfo = calculate_parsed_userinfo(Rest, T),
+ URI2 = maybe_add_path(URI1),
+ URI2#{userinfo => Userinfo}
+ catch
+ throw:{_,_,_} ->
+ {T, URI1} = parse_host(Rest, URI),
+ Host = calculate_parsed_host_port(Rest, T),
+ URI2 = maybe_add_path(URI1),
+ URI2#{host => remove_brackets(Host)}
+ end;
+parse_relative_part(?STRING_REST($/, Rest), URI) ->
+ {T, URI1} = parse_segment(Rest, URI), % path-absolute
+ Path = calculate_parsed_part(Rest, T),
+ URI1#{path => ?STRING_REST($/, Path)};
+parse_relative_part(?STRING_REST($?, Rest), URI) ->
+ {T, URI1} = parse_query(Rest, URI), % path-empty ?query
+ Query = calculate_parsed_query_fragment(Rest, T),
+ URI2 = maybe_add_path(URI1),
+ URI2#{query => Query};
+parse_relative_part(?STRING_REST($#, Rest), URI) ->
+ {T, URI1} = parse_fragment(Rest, URI), % path-empty
+ Fragment = calculate_parsed_query_fragment(Rest, T),
+ URI2 = maybe_add_path(URI1),
+ URI2#{fragment => Fragment};
+parse_relative_part(?STRING_REST(Char, Rest), URI) ->
+ case is_segment_nz_nc(Char) of
+ true ->
+ {T, URI1} = parse_segment_nz_nc(Rest, URI), % path-noscheme
+ Path = calculate_parsed_part(Rest, T),
+ URI1#{path => ?STRING_REST(Char, Path)};
+ false -> throw({error,invalid_uri,[Char]})
+ end.
+
+
+%%-------------------------------------------------------------------------
+%% [RFC 3986, Chapter 3.3. Path]
+%%
+%% The path component contains data, usually organized in hierarchical
+%% form, that, along with data in the non-hierarchical query component
+%% (Section 3.4), serves to identify a resource within the scope of the
+%% URI's scheme and naming authority (if any). The path is terminated
+%% by the first question mark ("?") or number sign ("#") character, or
+%% by the end of the URI.
+%%
+%% path = path-abempty ; begins with "/" or is empty
+%% / path-absolute ; begins with "/" but not "//"
+%% / path-noscheme ; begins with a non-colon segment
+%% / path-rootless ; begins with a segment
+%% / path-empty ; zero characters
+%%
+%% path-abempty = *( "/" segment )
+%% path-absolute = "/" [ segment-nz *( "/" segment ) ]
+%% path-noscheme = segment-nz-nc *( "/" segment )
+%% path-rootless = segment-nz *( "/" segment )
+%% path-empty = 0<pchar>
+%% segment = *pchar
+%% segment-nz = 1*pchar
+%% segment-nz-nc = 1*( unreserved / pct-encoded / sub-delims / "@" )
+%% ; non-zero-length segment without any colon ":"
+%%
+%% pchar = unreserved / pct-encoded / sub-delims / ":" / "@"
+%%-------------------------------------------------------------------------
+
+%%-------------------------------------------------------------------------
+%% path-abempty
+%%-------------------------------------------------------------------------
+-spec parse_segment(binary(), uri_map()) -> {binary(), uri_map()}.
+parse_segment(?STRING_REST($/, Rest), URI) ->
+ parse_segment(Rest, URI); % segment
+parse_segment(?STRING_REST($?, Rest), URI) ->
+ {T, URI1} = parse_query(Rest, URI), % ?query
+ Query = calculate_parsed_query_fragment(Rest, T),
+ {Rest, URI1#{query => Query}};
+parse_segment(?STRING_REST($#, Rest), URI) ->
+ {T, URI1} = parse_fragment(Rest, URI),
+ Fragment = calculate_parsed_query_fragment(Rest, T),
+ {Rest, URI1#{fragment => Fragment}};
+parse_segment(?STRING_REST(Char, Rest), URI) ->
+ case is_pchar(Char) of
+ true -> parse_segment(Rest, URI);
+ false -> throw({error,invalid_uri,[Char]})
+ end;
+parse_segment(?STRING_EMPTY, URI) ->
+ {?STRING_EMPTY, URI}.
+
+
+%%-------------------------------------------------------------------------
+%% path-noscheme
+%%-------------------------------------------------------------------------
+-spec parse_segment_nz_nc(binary(), uri_map()) -> {binary(), uri_map()}.
+parse_segment_nz_nc(?STRING_REST($/, Rest), URI) ->
+ parse_segment(Rest, URI); % segment
+parse_segment_nz_nc(?STRING_REST($?, Rest), URI) ->
+ {T, URI1} = parse_query(Rest, URI), % ?query
+ Query = calculate_parsed_query_fragment(Rest, T),
+ {Rest, URI1#{query => Query}};
+parse_segment_nz_nc(?STRING_REST($#, Rest), URI) ->
+ {T, URI1} = parse_fragment(Rest, URI),
+ Fragment = calculate_parsed_query_fragment(Rest, T),
+ {Rest, URI1#{fragment => Fragment}};
+parse_segment_nz_nc(?STRING_REST(Char, Rest), URI) ->
+ case is_segment_nz_nc(Char) of
+ true -> parse_segment_nz_nc(Rest, URI);
+ false -> throw({error,invalid_uri,[Char]})
+ end;
+parse_segment_nz_nc(?STRING_EMPTY, URI) ->
+ {?STRING_EMPTY, URI}.
+
+
+%% Check if char is pchar.
+-spec is_pchar(char()) -> boolean().
+is_pchar($%) -> true; % pct-encoded
+is_pchar($:) -> true;
+is_pchar($@) -> true;
+is_pchar(Char) -> is_unreserved(Char) orelse is_sub_delim(Char).
+
+%% Check if char is segment_nz_nc.
+-spec is_segment_nz_nc(char()) -> boolean().
+is_segment_nz_nc($%) -> true; % pct-encoded
+is_segment_nz_nc($@) -> true;
+is_segment_nz_nc(Char) -> is_unreserved(Char) orelse is_sub_delim(Char).
+
+
+%%-------------------------------------------------------------------------
+%% [RFC 3986, Chapter 3.1. Scheme]
+%%
+%% Each URI begins with a scheme name that refers to a specification for
+%% assigning identifiers within that scheme.
+%%
+%% scheme = ALPHA *( ALPHA / DIGIT / "+" / "-" / "." )
+%%-------------------------------------------------------------------------
+-spec parse_scheme_start(binary(), uri_map()) -> uri_map().
+parse_scheme_start(?STRING_REST(Char, Rest), URI) ->
+ case is_alpha(Char) of
+ true -> {T, URI1} = parse_scheme(Rest, URI),
+ Scheme = calculate_parsed_scheme(Rest, T),
+ URI2 = maybe_add_path(URI1),
+ URI2#{scheme => ?STRING_REST(Char, Scheme)};
+ false -> throw({error,invalid_uri,[Char]})
+ end.
+
+%% Add path component if it missing after parsing the URI.
+%% According to the URI specification there is always a
+%% path component in every URI-reference and it can be
+%% empty.
+maybe_add_path(Map) ->
+ case maps:is_key(path, Map) of
+ false ->
+ Map#{path => <<>>};
+ _Else ->
+ Map
+ end.
+
+
+
+-spec parse_scheme(binary(), uri_map()) -> {binary(), uri_map()}.
+parse_scheme(?STRING_REST($:, Rest), URI) ->
+ {_, URI1} = parse_hier(Rest, URI),
+ {Rest, URI1};
+parse_scheme(?STRING_REST(Char, Rest), URI) ->
+ case is_scheme(Char) of
+ true -> parse_scheme(Rest, URI);
+ false -> throw({error,invalid_uri,[Char]})
+ end;
+parse_scheme(?STRING_EMPTY, _URI) ->
+ throw({error,invalid_uri,<<>>}).
+
+
+%% Check if char is allowed in scheme
+-spec is_scheme(char()) -> boolean().
+is_scheme($+) -> true;
+is_scheme($-) -> true;
+is_scheme($.) -> true;
+is_scheme(Char) -> is_alpha(Char) orelse is_digit(Char).
+
+
+%%-------------------------------------------------------------------------
+%% hier-part = "//" authority path-abempty
+%% / path-absolute
+%% / path-rootless
+%% / path-empty
+%%-------------------------------------------------------------------------
+-spec parse_hier(binary(), uri_map()) -> {binary(), uri_map()}.
+parse_hier(?STRING_REST("//", Rest), URI) ->
+ % Parse userinfo - "//" is NOT part of authority
+ try parse_userinfo(Rest, URI) of
+ {T, URI1} ->
+ Userinfo = calculate_parsed_userinfo(Rest, T),
+ {Rest, URI1#{userinfo => Userinfo}}
+ catch
+ throw:{_,_,_} ->
+ {T, URI1} = parse_host(Rest, URI),
+ Host = calculate_parsed_host_port(Rest, T),
+ {Rest, URI1#{host => remove_brackets(Host)}}
+ end;
+parse_hier(?STRING_REST($/, Rest), URI) ->
+ {T, URI1} = parse_segment(Rest, URI), % path-absolute
+ Path = calculate_parsed_part(Rest, T),
+ {Rest, URI1#{path => ?STRING_REST($/, Path)}};
+parse_hier(?STRING_REST($?, Rest), URI) ->
+ {T, URI1} = parse_query(Rest, URI), % path-empty ?query
+ Query = calculate_parsed_query_fragment(Rest, T),
+ {Rest, URI1#{query => Query}};
+parse_hier(?STRING_REST($#, Rest), URI) ->
+ {T, URI1} = parse_fragment(Rest, URI), % path-empty
+ Fragment = calculate_parsed_query_fragment(Rest, T),
+ {Rest, URI1#{fragment => Fragment}};
+parse_hier(?STRING_REST(Char, Rest), URI) -> % path-rootless
+ case is_pchar(Char) of
+ true -> % segment_nz
+ {T, URI1} = parse_segment(Rest, URI),
+ Path = calculate_parsed_part(Rest, T),
+ {Rest, URI1#{path => ?STRING_REST(Char, Path)}};
+ false -> throw({error,invalid_uri,[Char]})
+ end;
+parse_hier(?STRING_EMPTY, URI) ->
+ {<<>>, URI}.
+
+
+%%-------------------------------------------------------------------------
+%% [RFC 3986, Chapter 3.2. Authority]
+%%
+%% Many URI schemes include a hierarchical element for a naming
+%% authority so that governance of the name space defined by the
+%% remainder of the URI is delegated to that authority (which may, in
+%% turn, delegate it further).
+%%
+%% The authority component is preceded by a double slash ("//") and is
+%% terminated by the next slash ("/"), question mark ("?"), or number
+%% sign ("#") character, or by the end of the URI.
+%%
+%% authority = [ userinfo "@" ] host [ ":" port ]
+%%
+%%
+%% [RFC 3986, Chapter 3.2.1. User Information]
+%%
+%% The userinfo subcomponent may consist of a user name and, optionally,
+%% scheme-specific information about how to gain authorization to access
+%% the resource. The user information, if present, is followed by a
+%% commercial at-sign ("@") that delimits it from the host.
+%%
+%% userinfo = *( unreserved / pct-encoded / sub-delims / ":" )
+%%-------------------------------------------------------------------------
+-spec parse_userinfo(binary(), uri_map()) -> {binary(), uri_map()}.
+parse_userinfo(?CHAR($@), URI) ->
+ {?STRING_EMPTY, URI#{host => <<>>}};
+parse_userinfo(?STRING_REST($@, Rest), URI) ->
+ {T, URI1} = parse_host(Rest, URI),
+ Host = calculate_parsed_host_port(Rest, T),
+ {Rest, URI1#{host => remove_brackets(Host)}};
+parse_userinfo(?STRING_REST(Char, Rest), URI) ->
+ case is_userinfo(Char) of
+ true -> parse_userinfo(Rest, URI);
+ false -> throw({error,invalid_uri,[Char]})
+ end;
+parse_userinfo(?STRING_EMPTY, _URI) ->
+ %% URI cannot end in userinfo state
+ throw({error,invalid_uri,<<>>}).
+
+
+%% Check if char is allowed in userinfo
+-spec is_userinfo(char()) -> boolean().
+is_userinfo($%) -> true; % pct-encoded
+is_userinfo($:) -> true;
+is_userinfo(Char) -> is_unreserved(Char) orelse is_sub_delim(Char).
+
+
+%%-------------------------------------------------------------------------
+%% [RFC 3986, Chapter 3.2.2. Host]
+%%
+%% The host subcomponent of authority is identified by an IP literal
+%% encapsulated within square brackets, an IPv4 address in dotted-
+%% decimal form, or a registered name.
+%%
+%% host = IP-literal / IPv4address / reg-name
+%%
+%% IP-literal = "[" ( IPv6address / IPvFuture ) "]"
+%%
+%% IPvFuture = "v" 1*HEXDIG "." 1*( unreserved / sub-delims / ":" )
+%%
+%% IPv6address = 6( h16 ":" ) ls32
+%% / "::" 5( h16 ":" ) ls32
+%% / [ h16 ] "::" 4( h16 ":" ) ls32
+%% / [ *1( h16 ":" ) h16 ] "::" 3( h16 ":" ) ls32
+%% / [ *2( h16 ":" ) h16 ] "::" 2( h16 ":" ) ls32
+%% / [ *3( h16 ":" ) h16 ] "::" h16 ":" ls32
+%% / [ *4( h16 ":" ) h16 ] "::" ls32
+%% / [ *5( h16 ":" ) h16 ] "::" h16
+%% / [ *6( h16 ":" ) h16 ] "::"
+%%
+%% ls32 = ( h16 ":" h16 ) / IPv4address
+%% ; least-significant 32 bits of address
+%%
+%% h16 = 1*4HEXDIG
+%% ; 16 bits of address represented in hexadecimal
+%%
+%% IPv4address = dec-octet "." dec-octet "." dec-octet "." dec-octet
+%%
+%% dec-octet = DIGIT ; 0-9
+%% / %x31-39 DIGIT ; 10-99
+%% / "1" 2DIGIT ; 100-199
+%% / "2" %x30-34 DIGIT ; 200-249
+%% / "25" %x30-35 ; 250-255
+%%
+%% reg-name = *( unreserved / pct-encoded / sub-delims )
+%%-------------------------------------------------------------------------
+-spec parse_host(binary(), uri_map()) -> {binary(), uri_map()}.
+parse_host(?STRING_REST($:, Rest), URI) ->
+ {T, URI1} = parse_port(Rest, URI),
+ H = calculate_parsed_host_port(Rest, T),
+ Port = get_port(H),
+ {Rest, URI1#{port => Port}};
+parse_host(?STRING_REST($/, Rest), URI) ->
+ {T, URI1} = parse_segment(Rest, URI), % path-abempty
+ Path = calculate_parsed_part(Rest, T),
+ {Rest, URI1#{path => ?STRING_REST($/, Path)}};
+parse_host(?STRING_REST($?, Rest), URI) ->
+ {T, URI1} = parse_query(Rest, URI), % path-empty ?query
+ Query = calculate_parsed_query_fragment(Rest, T),
+ {Rest, URI1#{query => Query}};
+parse_host(?STRING_REST($[, Rest), URI) ->
+ parse_ipv6_bin(Rest, [], URI);
+parse_host(?STRING_REST($#, Rest), URI) ->
+ {T, URI1} = parse_fragment(Rest, URI), % path-empty
+ Fragment = calculate_parsed_query_fragment(Rest, T),
+ {Rest, URI1#{fragment => Fragment}};
+parse_host(?STRING_REST(Char, Rest), URI) ->
+ case is_digit(Char) of
+ true ->
+ try parse_ipv4_bin(Rest, [Char], URI)
+ catch
+ throw:{_,_,_} ->
+ parse_reg_name(?STRING_REST(Char, Rest), URI)
+ end;
+ false -> parse_reg_name(?STRING_REST(Char, Rest), URI)
+ end;
+parse_host(?STRING_EMPTY, URI) ->
+ {?STRING_EMPTY, URI}.
+
+
+-spec parse_reg_name(binary(), uri_map()) -> {binary(), uri_map()}.
+parse_reg_name(?STRING_REST($:, Rest), URI) ->
+ {T, URI1} = parse_port(Rest, URI),
+ H = calculate_parsed_host_port(Rest, T),
+ Port = get_port(H),
+ {Rest, URI1#{port => Port}};
+parse_reg_name(?STRING_REST($/, Rest), URI) ->
+ {T, URI1} = parse_segment(Rest, URI), % path-abempty
+ Path = calculate_parsed_part(Rest, T),
+ {Rest, URI1#{path => ?STRING_REST($/, Path)}};
+parse_reg_name(?STRING_REST($?, Rest), URI) ->
+ {T, URI1} = parse_query(Rest, URI), % path-empty ?query
+ Query = calculate_parsed_query_fragment(Rest, T),
+ {Rest, URI1#{query => Query}};
+parse_reg_name(?STRING_REST($#, Rest), URI) ->
+ {T, URI1} = parse_fragment(Rest, URI), % path-empty
+ Fragment = calculate_parsed_query_fragment(Rest, T),
+ {Rest, URI1#{fragment => Fragment}};
+parse_reg_name(?STRING_REST(Char, Rest), URI) ->
+ case is_reg_name(Char) of
+ true -> parse_reg_name(Rest, URI);
+ false -> throw({error,invalid_uri,[Char]})
+ end;
+parse_reg_name(?STRING_EMPTY, URI) ->
+ {?STRING_EMPTY, URI}.
+
+%% Check if char is allowed in reg-name
+-spec is_reg_name(char()) -> boolean().
+is_reg_name($%) -> true;
+is_reg_name(Char) -> is_unreserved(Char) orelse is_sub_delim(Char).
+
+
+-spec parse_ipv4_bin(binary(), list(), uri_map()) -> {binary(), uri_map()}.
+parse_ipv4_bin(?STRING_REST($:, Rest), Acc, URI) ->
+ _ = validate_ipv4_address(lists:reverse(Acc)),
+ {T, URI1} = parse_port(Rest, URI),
+ H = calculate_parsed_host_port(Rest, T),
+ Port = get_port(H),
+ {Rest, URI1#{port => Port}};
+parse_ipv4_bin(?STRING_REST($/, Rest), Acc, URI) ->
+ _ = validate_ipv4_address(lists:reverse(Acc)),
+ {T, URI1} = parse_segment(Rest, URI), % path-abempty
+ Path = calculate_parsed_part(Rest, T),
+ {Rest, URI1#{path => ?STRING_REST($/, Path)}};
+parse_ipv4_bin(?STRING_REST($?, Rest), Acc, URI) ->
+ _ = validate_ipv4_address(lists:reverse(Acc)),
+ {T, URI1} = parse_query(Rest, URI), % path-empty ?query
+ Query = calculate_parsed_query_fragment(Rest, T),
+ {Rest, URI1#{query => Query}};
+parse_ipv4_bin(?STRING_REST($#, Rest), Acc, URI) ->
+ _ = validate_ipv4_address(lists:reverse(Acc)),
+ {T, URI1} = parse_fragment(Rest, URI), % path-empty
+ Fragment = calculate_parsed_query_fragment(Rest, T),
+ {Rest, URI1#{fragment => Fragment}};
+parse_ipv4_bin(?STRING_REST(Char, Rest), Acc, URI) ->
+ case is_ipv4(Char) of
+ true -> parse_ipv4_bin(Rest, [Char|Acc], URI);
+ false -> throw({error,invalid_uri,[Char]})
+ end;
+parse_ipv4_bin(?STRING_EMPTY, Acc, URI) ->
+ _ = validate_ipv4_address(lists:reverse(Acc)),
+ {?STRING_EMPTY, URI}.
+
+
+%% Check if char is allowed in IPv4 addresses
+-spec is_ipv4(char()) -> boolean().
+is_ipv4($.) -> true;
+is_ipv4(Char) -> is_digit(Char).
+
+-spec validate_ipv4_address(list()) -> list().
+validate_ipv4_address(Addr) ->
+ case inet:parse_ipv4strict_address(Addr) of
+ {ok, _} -> Addr;
+ {error, _} -> throw({error,invalid_uri,Addr})
+ end.
+
+
+-spec parse_ipv6_bin(binary(), list(), uri_map()) -> {binary(), uri_map()}.
+parse_ipv6_bin(?STRING_REST($], Rest), Acc, URI) ->
+ _ = validate_ipv6_address(lists:reverse(Acc)),
+ parse_ipv6_bin_end(Rest, URI);
+parse_ipv6_bin(?STRING_REST(Char, Rest), Acc, URI) ->
+ case is_ipv6(Char) of
+ true -> parse_ipv6_bin(Rest, [Char|Acc], URI);
+ false -> throw({error,invalid_uri,[Char]})
+ end;
+parse_ipv6_bin(?STRING_EMPTY, _Acc, _URI) ->
+ throw({error,invalid_uri,<<>>}).
+
+%% Check if char is allowed in IPv6 addresses
+-spec is_ipv6(char()) -> boolean().
+is_ipv6($:) -> true;
+is_ipv6($.) -> true;
+is_ipv6(Char) -> is_hex_digit(Char).
+
+
+-spec parse_ipv6_bin_end(binary(), uri_map()) -> {binary(), uri_map()}.
+parse_ipv6_bin_end(?STRING_REST($:, Rest), URI) ->
+ {T, URI1} = parse_port(Rest, URI),
+ H = calculate_parsed_host_port(Rest, T),
+ Port = get_port(H),
+ {Rest, URI1#{port => Port}};
+parse_ipv6_bin_end(?STRING_REST($/, Rest), URI) ->
+ {T, URI1} = parse_segment(Rest, URI), % path-abempty
+ Path = calculate_parsed_part(Rest, T),
+ {Rest, URI1#{path => ?STRING_REST($/, Path)}};
+parse_ipv6_bin_end(?STRING_REST($?, Rest), URI) ->
+ {T, URI1} = parse_query(Rest, URI), % path-empty ?query
+ Query = calculate_parsed_query_fragment(Rest, T),
+ {Rest, URI1#{query => Query}};
+parse_ipv6_bin_end(?STRING_REST($#, Rest), URI) ->
+ {T, URI1} = parse_fragment(Rest, URI), % path-empty
+ Fragment = calculate_parsed_query_fragment(Rest, T),
+ {Rest, URI1#{fragment => Fragment}};
+parse_ipv6_bin_end(?STRING_REST(Char, Rest), URI) ->
+ case is_ipv6(Char) of
+ true -> parse_ipv6_bin_end(Rest, URI);
+ false -> throw({error,invalid_uri,[Char]})
+ end;
+parse_ipv6_bin_end(?STRING_EMPTY, URI) ->
+ {?STRING_EMPTY, URI}.
+
+-spec validate_ipv6_address(list()) -> list().
+validate_ipv6_address(Addr) ->
+ case inet:parse_ipv6strict_address(Addr) of
+ {ok, _} -> Addr;
+ {error, _} -> throw({error,invalid_uri,Addr})
+ end.
+
+
+%%-------------------------------------------------------------------------
+%% [RFC 3986, Chapter 3.2.2. Port]
+%%
+%% The port subcomponent of authority is designated by an optional port
+%% number in decimal following the host and delimited from it by a
+%% single colon (":") character.
+%%
+%% port = *DIGIT
+%%-------------------------------------------------------------------------
+-spec parse_port(binary(), uri_map()) -> {binary(), uri_map()}.
+parse_port(?STRING_REST($/, Rest), URI) ->
+ {T, URI1} = parse_segment(Rest, URI), % path-abempty
+ Path = calculate_parsed_part(Rest, T),
+ {Rest, URI1#{path => ?STRING_REST($/, Path)}};
+parse_port(?STRING_REST($?, Rest), URI) ->
+ {T, URI1} = parse_query(Rest, URI), % path-empty ?query
+ Query = calculate_parsed_query_fragment(Rest, T),
+ {Rest, URI1#{query => Query}};
+parse_port(?STRING_REST($#, Rest), URI) ->
+ {T, URI1} = parse_fragment(Rest, URI), % path-empty
+ Fragment = calculate_parsed_query_fragment(Rest, T),
+ {Rest, URI1#{fragment => Fragment}};
+parse_port(?STRING_REST(Char, Rest), URI) ->
+ case is_digit(Char) of
+ true -> parse_port(Rest, URI);
+ false -> throw({error,invalid_uri,[Char]})
+ end;
+parse_port(?STRING_EMPTY, URI) ->
+ {?STRING_EMPTY, URI}.
+
+
+%%-------------------------------------------------------------------------
+%% [RFC 3986, Chapter 3.4. Query]
+%%
+%% The query component contains non-hierarchical data that, along with
+%% data in the path component (Section 3.3), serves to identify a
+%% resource within the scope of the URI's scheme and naming authority
+%% (if any). The query component is indicated by the first question
+%% mark ("?") character and terminated by a number sign ("#") character
+%% or by the end of the URI.
+%%
+%% query = *( pchar / "/" / "?" )
+%%-------------------------------------------------------------------------
+-spec parse_query(binary(), uri_map()) -> {binary(), uri_map()}.
+parse_query(?STRING_REST($#, Rest), URI) ->
+ {T, URI1} = parse_fragment(Rest, URI),
+ Fragment = calculate_parsed_query_fragment(Rest, T),
+ {Rest, URI1#{fragment => Fragment}};
+parse_query(?STRING_REST(Char, Rest), URI) ->
+ case is_query(Char) of
+ true -> parse_query(Rest, URI);
+ false -> throw({error,invalid_uri,[Char]})
+ end;
+parse_query(?STRING_EMPTY, URI) ->
+ {?STRING_EMPTY, URI}.
+
+
+%% Check if char is allowed in query
+-spec is_query(char()) -> boolean().
+is_query($/) -> true;
+is_query($?) -> true;
+is_query(Char) -> is_pchar(Char).
+
+
+%%-------------------------------------------------------------------------
+%% [RFC 3986, Chapter 3.5. Fragment]
+%%
+%% The fragment identifier component of a URI allows indirect
+%% identification of a secondary resource by reference to a primary
+%% resource and additional identifying information.
+%%
+%% fragment = *( pchar / "/" / "?" )
+%%-------------------------------------------------------------------------
+-spec parse_fragment(binary(), uri_map()) -> {binary(), uri_map()}.
+parse_fragment(?STRING_REST(Char, Rest), URI) ->
+ case is_fragment(Char) of
+ true -> parse_fragment(Rest, URI);
+ false -> throw({error,invalid_uri,[Char]})
+ end;
+parse_fragment(?STRING_EMPTY, URI) ->
+ {?STRING_EMPTY, URI}.
+
+
+%% Check if char is allowed in fragment
+-spec is_fragment(char()) -> boolean().
+is_fragment($/) -> true;
+is_fragment($?) -> true;
+is_fragment(Char) -> is_pchar(Char).
+
+
+%%-------------------------------------------------------------------------
+%% [RFC 3986, Chapter 2.2. Reserved Characters]
+%%
+%% reserved = gen-delims / sub-delims
+%%
+%% gen-delims = ":" / "/" / "?" / "#" / "[" / "]" / "@"
+%%
+%% sub-delims = "!" / "$" / "&" / "'" / "(" / ")"
+%% / "*" / "+" / "," / ";" / "="
+%%
+%%-------------------------------------------------------------------------
+
+%% Return true if input char is reserved.
+-spec is_reserved(char()) -> boolean().
+is_reserved($:) -> true;
+is_reserved($/) -> true;
+is_reserved($?) -> true;
+is_reserved($#) -> true;
+is_reserved($[) -> true;
+is_reserved($]) -> true;
+is_reserved($@) -> true;
+
+is_reserved($!) -> true;
+is_reserved($$) -> true;
+is_reserved($&) -> true;
+is_reserved($') -> true;
+is_reserved($() -> true;
+is_reserved($)) -> true;
+
+is_reserved($*) -> true;
+is_reserved($+) -> true;
+is_reserved($,) -> true;
+is_reserved($;) -> true;
+is_reserved($=) -> true;
+is_reserved(_) -> false.
+
+
+%% Check if char is sub-delim.
+-spec is_sub_delim(char()) -> boolean().
+is_sub_delim($!) -> true;
+is_sub_delim($$) -> true;
+is_sub_delim($&) -> true;
+is_sub_delim($') -> true;
+is_sub_delim($() -> true;
+is_sub_delim($)) -> true;
+
+is_sub_delim($*) -> true;
+is_sub_delim($+) -> true;
+is_sub_delim($,) -> true;
+is_sub_delim($;) -> true;
+is_sub_delim($=) -> true;
+is_sub_delim(_) -> false.
+
+
+%%-------------------------------------------------------------------------
+%% [RFC 3986, Chapter 2.3. Unreserved Characters]
+%%
+%% unreserved = ALPHA / DIGIT / "-" / "." / "_" / "~"
+%%
+%%-------------------------------------------------------------------------
+-spec is_unreserved(char()) -> boolean().
+is_unreserved($-) -> true;
+is_unreserved($.) -> true;
+is_unreserved($_) -> true;
+is_unreserved($~) -> true;
+is_unreserved(Char) -> is_alpha(Char) orelse is_digit(Char).
+
+-spec is_alpha(char()) -> boolean().
+is_alpha(C)
+ when $A =< C, C =< $Z;
+ $a =< C, C =< $z -> true;
+is_alpha(_) -> false.
+
+-spec is_digit(char()) -> boolean().
+is_digit(C)
+ when $0 =< C, C =< $9 -> true;
+is_digit(_) -> false.
+
+-spec is_hex_digit(char()) -> boolean().
+is_hex_digit(C)
+ when $0 =< C, C =< $9;$a =< C, C =< $f;$A =< C, C =< $F -> true;
+is_hex_digit(_) -> false.
+
+
+%% Remove enclosing brackets from binary
+-spec remove_brackets(binary()) -> binary().
+remove_brackets(<<$[/utf8, Rest/binary>>) ->
+ {H,T} = split_binary(Rest, byte_size(Rest) - 1),
+ case T =:= <<$]/utf8>> of
+ true -> H;
+ false -> Rest
+ end;
+remove_brackets(Addr) -> Addr.
+
+
+%%-------------------------------------------------------------------------
+%% Helper functions for calculating the parsed binary.
+%%-------------------------------------------------------------------------
+-spec calculate_parsed_scheme(binary(), binary()) -> binary().
+calculate_parsed_scheme(Input, <<>>) ->
+ strip_last_char(Input, [$:]);
+calculate_parsed_scheme(Input, Unparsed) ->
+ get_parsed_binary(Input, Unparsed).
+
+
+-spec calculate_parsed_part(binary(), binary()) -> binary().
+calculate_parsed_part(Input, <<>>) ->
+ strip_last_char(Input, [$?,$#]);
+calculate_parsed_part(Input, Unparsed) ->
+ get_parsed_binary(Input, Unparsed).
+
+
+-spec calculate_parsed_userinfo(binary(), binary()) -> binary().
+calculate_parsed_userinfo(Input, <<>>) ->
+ strip_last_char(Input, [$?,$#,$@]);
+calculate_parsed_userinfo(Input, Unparsed) ->
+ get_parsed_binary(Input, Unparsed).
+
+
+-spec calculate_parsed_host_port(binary(), binary()) -> binary().
+calculate_parsed_host_port(Input, <<>>) ->
+ strip_last_char(Input, [$:,$?,$#,$/]);
+calculate_parsed_host_port(Input, Unparsed) ->
+ get_parsed_binary(Input, Unparsed).
+
+
+calculate_parsed_query_fragment(Input, <<>>) ->
+ strip_last_char(Input, [$#]);
+calculate_parsed_query_fragment(Input, Unparsed) ->
+ get_parsed_binary(Input, Unparsed).
+
+
+get_port(<<>>) ->
+ undefined;
+get_port(B) ->
+ try binary_to_integer(B)
+ catch
+ error:badarg ->
+ throw({error, invalid_uri, B})
+ end.
+
+
+%% Strip last char if it is in list
+%%
+%% This function is optimized for speed: parse/1 is about 10% faster than
+%% with an alternative implementation based on lists and sets.
+strip_last_char(<<>>, _) -> <<>>;
+strip_last_char(Input, [C0]) ->
+ case binary:last(Input) of
+ C0 ->
+ init_binary(Input);
+ _Else ->
+ Input
+ end;
+strip_last_char(Input, [C0,C1]) ->
+ case binary:last(Input) of
+ C0 ->
+ init_binary(Input);
+ C1 ->
+ init_binary(Input);
+ _Else ->
+ Input
+ end;
+strip_last_char(Input, [C0,C1,C2]) ->
+ case binary:last(Input) of
+ C0 ->
+ init_binary(Input);
+ C1 ->
+ init_binary(Input);
+ C2 ->
+ init_binary(Input);
+ _Else ->
+ Input
+ end;
+strip_last_char(Input, [C0,C1,C2,C3]) ->
+ case binary:last(Input) of
+ C0 ->
+ init_binary(Input);
+ C1 ->
+ init_binary(Input);
+ C2 ->
+ init_binary(Input);
+ C3 ->
+ init_binary(Input);
+ _Else ->
+ Input
+ end.
+
+
+%% Get parsed binary
+get_parsed_binary(Input, Unparsed) ->
+ {First, _} = split_binary(Input, byte_size(Input) - byte_size_exl_head(Unparsed)),
+ First.
+
+
+%% Return all bytes of the binary except the last one. The binary must be non-empty.
+init_binary(B) ->
+ {Init, _} =
+ split_binary(B, byte_size(B) - 1),
+ Init.
+
+
+%% Returns the size of a binary exluding the first element.
+%% Used in calls to split_binary().
+-spec byte_size_exl_head(binary()) -> number().
+byte_size_exl_head(<<>>) -> 0;
+byte_size_exl_head(Binary) -> byte_size(Binary) + 1.
+
+
+%%-------------------------------------------------------------------------
+%% [RFC 3986, Chapter 2.1. Percent-Encoding]
+%%
+%% A percent-encoding mechanism is used to represent a data octet in a
+%% component when that octet's corresponding character is outside the
+%% allowed set or is being used as a delimiter of, or within, the
+%% component. A percent-encoded octet is encoded as a character
+%% triplet, consisting of the percent character "%" followed by the two
+%% hexadecimal digits representing that octet's numeric value. For
+%% example, "%20" is the percent-encoding for the binary octet
+%% "00100000" (ABNF: %x20), which in US-ASCII corresponds to the space
+%% character (SP). Section 2.4 describes when percent-encoding and
+%% decoding is applied.
+%%
+%% pct-encoded = "%" HEXDIG HEXDIG
+%%-------------------------------------------------------------------------
+
+%%-------------------------------------------------------------------------
+%% Percent-encode
+%%-------------------------------------------------------------------------
+
+%% Only validates as scheme cannot have percent-encoded characters
+-spec encode_scheme(list()|binary()) -> list() | binary().
+encode_scheme([]) ->
+ throw({error,invalid_scheme,""});
+encode_scheme(<<>>) ->
+ throw({error,invalid_scheme,<<>>});
+encode_scheme(Scheme) ->
+ case validate_scheme(Scheme) of
+ true -> Scheme;
+ false -> throw({error,invalid_scheme,Scheme})
+ end.
+
+-spec encode_userinfo(list()|binary()) -> list() | binary().
+encode_userinfo(Cs) ->
+ encode(Cs, fun is_userinfo/1).
+
+-spec encode_host(list()|binary()) -> list() | binary().
+encode_host(Cs) ->
+ case classify_host(Cs) of
+ regname -> Cs;
+ ipv4 -> Cs;
+ ipv6 -> bracket_ipv6(Cs);
+ other -> encode(Cs, fun is_reg_name/1)
+ end.
+
+-spec encode_path(list()|binary()) -> list() | binary().
+encode_path(Cs) ->
+ encode(Cs, fun is_path/1).
+
+-spec encode_query(list()|binary()) -> list() | binary().
+encode_query(Cs) ->
+ encode(Cs, fun is_query/1).
+
+-spec encode_fragment(list()|binary()) -> list() | binary().
+encode_fragment(Cs) ->
+ encode(Cs, fun is_fragment/1).
+
+%%-------------------------------------------------------------------------
+%% Helper funtions for percent-decode
+%%-------------------------------------------------------------------------
+
+-spec decode(list()|binary()) -> list() | binary().
+decode(Cs) ->
+ decode(Cs, <<>>).
+%%
+decode(L, Acc) when is_list(L) ->
+ B0 = unicode:characters_to_binary(L),
+ B1 = decode(B0, Acc),
+ unicode:characters_to_list(B1);
+decode(<<$%,C0,C1,Cs/binary>>, Acc) ->
+ case is_hex_digit(C0) andalso is_hex_digit(C1) of
+ true ->
+ B = ?HEX2DEC(C0)*16+?HEX2DEC(C1),
+ case is_reserved(B) of
+ true ->
+ %% [2.2] Characters in the reserved set are protected from
+ %% normalization.
+ %% [2.1] For consistency, URI producers and normalizers should
+ %% use uppercase hexadecimal digits for all percent-
+ %% encodings.
+ H0 = hex_to_upper(C0),
+ H1 = hex_to_upper(C1),
+ decode(Cs, <<Acc/binary,$%,H0,H1>>);
+ false ->
+ decode(Cs, <<Acc/binary, B>>)
+ end;
+ false -> throw({error,invalid_percent_encoding,<<$%,C0,C1>>})
+ end;
+decode(<<C,Cs/binary>>, Acc) ->
+ decode(Cs, <<Acc/binary, C>>);
+decode(<<>>, Acc) ->
+ check_utf8(Acc).
+
+%% Returns Cs if it is utf8 encoded.
+check_utf8(Cs) ->
+ case unicode:characters_to_list(Cs) of
+ {incomplete,_,_} ->
+ throw({error,invalid_utf8,Cs});
+ {error,_,_} ->
+ throw({error,invalid_utf8,Cs});
+ _ -> Cs
+ end.
+
+%% Convert hex digit to uppercase form
+hex_to_upper(H) when $a =< H, H =< $f ->
+ H - 32;
+hex_to_upper(H) when $0 =< H, H =< $9;$A =< H, H =< $F->
+ H;
+hex_to_upper(H) ->
+ throw({error,invalid_input, H}).
+
+%% Check if char is allowed in host
+-spec is_host(char()) -> boolean().
+is_host($:) -> true;
+is_host(Char) -> is_unreserved(Char) orelse is_sub_delim(Char).
+
+%% Check if char is allowed in path
+-spec is_path(char()) -> boolean().
+is_path($/) -> true;
+is_path(Char) -> is_pchar(Char).
+
+
+%%-------------------------------------------------------------------------
+%% Helper functions for percent-encode
+%%-------------------------------------------------------------------------
+-spec encode(list()|binary(), fun()) -> list() | binary().
+encode(Component, Fun) when is_list(Component) ->
+ B = unicode:characters_to_binary(Component),
+ unicode:characters_to_list(encode(B, Fun, <<>>));
+encode(Component, Fun) when is_binary(Component) ->
+ encode(Component, Fun, <<>>).
+%%
+encode(<<Char/utf8, Rest/binary>>, Fun, Acc) ->
+ C = encode_codepoint_binary(Char, Fun),
+ encode(Rest, Fun, <<Acc/binary,C/binary>>);
+encode(<<Char, Rest/binary>>, _Fun, _Acc) ->
+ throw({error,invalid_input,<<Char,Rest/binary>>});
+encode(<<>>, _Fun, Acc) ->
+ Acc.
+
+
+-spec encode_codepoint_binary(integer(), fun()) -> binary().
+encode_codepoint_binary(C, Fun) ->
+ case Fun(C) of
+ false -> percent_encode_binary(C);
+ true -> <<C>>
+ end.
+
+
+-spec percent_encode_binary(integer()) -> binary().
+percent_encode_binary(Code) ->
+ percent_encode_binary(<<Code/utf8>>, <<>>).
+
+
+percent_encode_binary(<<A:4,B:4,Rest/binary>>, Acc) ->
+ percent_encode_binary(Rest, <<Acc/binary,$%,(?DEC2HEX(A)),(?DEC2HEX(B))>>);
+percent_encode_binary(<<>>, Acc) ->
+ Acc.
+
+
+%%-------------------------------------------------------------------------
+%%-------------------------------------------------------------------------
+validate_scheme([]) -> true;
+validate_scheme([H|T]) ->
+ case is_scheme(H) of
+ true -> validate_scheme(T);
+ false -> false
+ end;
+validate_scheme(<<>>) -> true;
+validate_scheme(<<H, Rest/binary>>) ->
+ case is_scheme(H) of
+ true -> validate_scheme(Rest);
+ false -> false
+ end.
+
+
+%%-------------------------------------------------------------------------
+%% Classifies hostname into the following categories:
+%% regname, ipv4 - address does not contain reserved characters to be
+%% percent-encoded
+%% ipv6 - address does not contain reserved characters but it shall be
+%% encolsed in brackets
+%% other - address shall be percent-encoded
+%%-------------------------------------------------------------------------
+classify_host([]) -> other;
+classify_host(Addr) when is_binary(Addr) ->
+ A = unicode:characters_to_list(Addr),
+ classify_host_ipv6(A);
+classify_host(Addr) ->
+ classify_host_ipv6(Addr).
+
+classify_host_ipv6(Addr) ->
+ case is_ipv6_address(Addr) of
+ true -> ipv6;
+ false -> classify_host_ipv4(Addr)
+ end.
+
+classify_host_ipv4(Addr) ->
+ case is_ipv4_address(Addr) of
+ true -> ipv4;
+ false -> classify_host_regname(Addr)
+ end.
+
+classify_host_regname([]) -> regname;
+classify_host_regname([H|T]) ->
+ case is_reg_name(H) of
+ true -> classify_host_regname(T);
+ false -> other
+ end.
+
+is_ipv4_address(Addr) ->
+ case inet:parse_ipv4strict_address(Addr) of
+ {ok, _} -> true;
+ {error, _} -> false
+ end.
+
+is_ipv6_address(Addr) ->
+ case inet:parse_ipv6strict_address(Addr) of
+ {ok, _} -> true;
+ {error, _} -> false
+ end.
+
+bracket_ipv6(Addr) when is_binary(Addr) ->
+ concat(<<$[,Addr/binary>>,<<$]>>);
+bracket_ipv6(Addr) when is_list(Addr) ->
+ [$[|Addr] ++ "]".
+
+
+%%-------------------------------------------------------------------------
+%% Helper funtions for recompose
+%%-------------------------------------------------------------------------
+
+%%-------------------------------------------------------------------------
+%% Checks if input Map has valid combination of fields that can be
+%% recomposed into a URI.
+%%
+%% The implementation is based on a decision tree that fulfills the
+%% following rules:
+%% - 'path' shall always be present in the input map
+%% URI = scheme ":" hier-part [ "?" query ] [ "#" fragment ]
+%% hier-part = "//" authority path-abempty
+%% / path-absolute
+%% / path-rootless
+%% / path-empty
+%% - 'host' shall be present in the input map when 'path' starts with
+%% two slashes ("//")
+%% path = path-abempty ; begins with "/" or is empty
+%% / path-absolute ; begins with "/" but not "//"
+%% / path-noscheme ; begins with a non-colon segment
+%% / path-rootless ; begins with a segment
+%% / path-empty ; zero characters
+%% path-abempty = *( "/" segment )
+%% segment = *pchar
+%% - 'host' shall be present if userinfo or port is present in input map
+%% authority = [ userinfo "@" ] host [ ":" port ]
+%% - All fields shall be valid (scheme, userinfo, host, port, path, query
+%% or fragment).
+%%-------------------------------------------------------------------------
+is_valid_map(#{path := Path} = Map) ->
+ ((starts_with_two_slash(Path) andalso is_valid_map_host(Map))
+ orelse
+ (maps:is_key(userinfo, Map) andalso is_valid_map_host(Map))
+ orelse
+ (maps:is_key(port, Map) andalso is_valid_map_host(Map))
+ orelse
+ all_fields_valid(Map));
+is_valid_map(#{}) ->
+ false.
+
+
+is_valid_map_host(Map) ->
+ maps:is_key(host, Map) andalso all_fields_valid(Map).
+
+
+all_fields_valid(Map) ->
+ Fun = fun(scheme, _, Acc) -> Acc;
+ (userinfo, _, Acc) -> Acc;
+ (host, _, Acc) -> Acc;
+ (port, _, Acc) -> Acc;
+ (path, _, Acc) -> Acc;
+ (query, _, Acc) -> Acc;
+ (fragment, _, Acc) -> Acc;
+ (_, _, _) -> false
+ end,
+ maps:fold(Fun, true, Map).
+
+
+starts_with_two_slash([$/,$/|_]) ->
+ true;
+starts_with_two_slash(?STRING_REST("//", _)) ->
+ true;
+starts_with_two_slash(_) -> false.
+
+
+update_scheme(#{scheme := Scheme}, _) ->
+ add_colon_postfix(encode_scheme(Scheme));
+update_scheme(#{}, _) ->
+ empty.
+
+
+update_userinfo(#{userinfo := Userinfo}, empty) ->
+ add_auth_prefix(encode_userinfo(Userinfo));
+update_userinfo(#{userinfo := Userinfo}, URI) ->
+ concat(URI,add_auth_prefix(encode_userinfo(Userinfo)));
+update_userinfo(#{}, empty) ->
+ empty;
+update_userinfo(#{}, URI) ->
+ URI.
+
+
+update_host(#{host := Host}, empty) ->
+ add_auth_prefix(encode_host(Host));
+update_host(#{host := Host} = Map, URI) ->
+ concat(URI,add_host_prefix(Map, encode_host(Host)));
+update_host(#{}, empty) ->
+ empty;
+update_host(#{}, URI) ->
+ URI.
+
+
+%% URI cannot be empty for ports. E.g. ":8080" is not a valid URI
+update_port(#{port := undefined}, URI) ->
+ concat(URI, <<":">>);
+update_port(#{port := Port}, URI) ->
+ concat(URI,add_colon(encode_port(Port)));
+update_port(#{}, URI) ->
+ URI.
+
+
+update_path(#{path := Path}, empty) ->
+ encode_path(Path);
+update_path(#{path := Path}, URI) ->
+ concat(URI,encode_path(Path));
+update_path(#{}, empty) ->
+ empty;
+update_path(#{}, URI) ->
+ URI.
+
+
+update_query(#{query := Query}, empty) ->
+ encode_query(Query);
+update_query(#{query := Query}, URI) ->
+ concat(URI,add_question_mark(encode_query(Query)));
+update_query(#{}, empty) ->
+ empty;
+update_query(#{}, URI) ->
+ URI.
+
+
+update_fragment(#{fragment := Fragment}, empty) ->
+ add_hashmark(encode_fragment(Fragment));
+update_fragment(#{fragment := Fragment}, URI) ->
+ concat(URI,add_hashmark(encode_fragment(Fragment)));
+update_fragment(#{}, empty) ->
+ "";
+update_fragment(#{}, URI) ->
+ URI.
+
+%%-------------------------------------------------------------------------
+%% Concatenates its arguments that can be lists and binaries.
+%% The result is a list if at least one of its argument is a list and
+%% binary otherwise.
+%%-------------------------------------------------------------------------
+concat(A, B) when is_binary(A), is_binary(B) ->
+ <<A/binary, B/binary>>;
+concat(A, B) when is_binary(A), is_list(B) ->
+ unicode:characters_to_list(A) ++ B;
+concat(A, B) when is_list(A) ->
+ A ++ maybe_to_list(B).
+
+add_hashmark(Comp) when is_binary(Comp) ->
+ <<$#, Comp/binary>>;
+add_hashmark(Comp) when is_list(Comp) ->
+ [$#|Comp].
+
+add_question_mark(Comp) when is_binary(Comp) ->
+ <<$?, Comp/binary>>;
+add_question_mark(Comp) when is_list(Comp) ->
+ [$?|Comp].
+
+add_colon(Comp) when is_binary(Comp) ->
+ <<$:, Comp/binary>>.
+
+add_colon_postfix(Comp) when is_binary(Comp) ->
+ <<Comp/binary,$:>>;
+add_colon_postfix(Comp) when is_list(Comp) ->
+ Comp ++ ":".
+
+add_auth_prefix(Comp) when is_binary(Comp) ->
+ <<"//", Comp/binary>>;
+add_auth_prefix(Comp) when is_list(Comp) ->
+ [$/,$/|Comp].
+
+add_host_prefix(#{userinfo := _}, Host) when is_binary(Host) ->
+ <<$@,Host/binary>>;
+add_host_prefix(#{}, Host) when is_binary(Host) ->
+ <<"//",Host/binary>>;
+add_host_prefix(#{userinfo := _}, Host) when is_list(Host) ->
+ [$@|Host];
+add_host_prefix(#{}, Host) when is_list(Host) ->
+ [$/,$/|Host].
+
+maybe_to_list(Comp) when is_binary(Comp) -> unicode:characters_to_list(Comp);
+maybe_to_list(Comp) -> Comp.
+
+encode_port(Port) ->
+ integer_to_binary(Port).
+
+%%-------------------------------------------------------------------------
+%% Helper functions for transcode
+%%-------------------------------------------------------------------------
+
+%%-------------------------------------------------------------------------
+%% uri_string:transcode(<<"x%00%00%00%F6"/utf32>>).
+%% 1. Convert (transcode/2) input to list form (list of unicode codepoints)
+%% "x%00%00%00%F6"
+%% 2. Accumulate characters until percent-encoded segment (transcode/4).
+%% Acc = "x"
+%% 3. Convert percent-encoded triplets to binary form (transcode_pct/4)
+%% <<0,0,0,246>>
+%% 4. Transcode in-encoded binary to out-encoding (utf32 -> utf8):
+%% <<195,182>>
+%% 5. Percent-encode out-encoded binary:
+%% <<"%C3%B6"/utf8>> = <<37,67,51,37,66,54>>
+%% 6. Convert binary to list form, reverse it and append the accumulator
+%% "6B%3C%" + "x"
+%% 7. Reverse Acc and return it
+%%-------------------------------------------------------------------------
+transcode([$%,_C0,_C1|_Rest] = L, Acc, InEnc, OutEnc) ->
+ transcode_pct(L, Acc, <<>>, InEnc, OutEnc);
+transcode([_C|_Rest] = L, Acc, InEnc, OutEnc) ->
+ transcode(L, Acc, [], InEnc, OutEnc).
+%%
+transcode([$%,_C0,_C1|_Rest] = L, Acc, List, InEncoding, OutEncoding) ->
+ transcode_pct(L, List ++ Acc, <<>>, InEncoding, OutEncoding);
+transcode([C|Rest], Acc, List, InEncoding, OutEncoding) ->
+ transcode(Rest, Acc, [C|List], InEncoding, OutEncoding);
+transcode([], Acc, List, _InEncoding, _OutEncoding) ->
+ lists:reverse(List ++ Acc).
+
+
+%% Transcode percent-encoded segment
+transcode_pct([$%,C0,C1|Rest] = L, Acc, B, InEncoding, OutEncoding) ->
+ case is_hex_digit(C0) andalso is_hex_digit(C1) of
+ true ->
+ Int = ?HEX2DEC(C0)*16+?HEX2DEC(C1),
+ transcode_pct(Rest, Acc, <<B/binary, Int>>, InEncoding, OutEncoding);
+ false -> throw({error, invalid_percent_encoding,L})
+ end;
+transcode_pct([_C|_Rest] = L, Acc, B, InEncoding, OutEncoding) ->
+ OutBinary = convert_to_binary(B, InEncoding, OutEncoding),
+ PctEncUtf8 = percent_encode_segment(OutBinary),
+ Out = lists:reverse(convert_to_list(PctEncUtf8, utf8)),
+ transcode(L, Out ++ Acc, [], InEncoding, OutEncoding);
+transcode_pct([], Acc, B, InEncoding, OutEncoding) ->
+ OutBinary = convert_to_binary(B, InEncoding, OutEncoding),
+ PctEncUtf8 = percent_encode_segment(OutBinary),
+ Out = convert_to_list(PctEncUtf8, utf8),
+ lists:reverse(Acc) ++ Out.
+
+
+%% Convert to binary
+convert_to_binary(Binary, InEncoding, OutEncoding) ->
+ case unicode:characters_to_binary(Binary, InEncoding, OutEncoding) of
+ {error, _List, RestData} ->
+ throw({error, invalid_input, RestData});
+ {incomplete, _List, RestData} ->
+ throw({error, invalid_input, RestData});
+ Result ->
+ Result
+ end.
+
+
+%% Convert to list
+convert_to_list(Binary, InEncoding) ->
+ case unicode:characters_to_list(Binary, InEncoding) of
+ {error, _List, RestData} ->
+ throw({error, invalid_input, RestData});
+ {incomplete, _List, RestData} ->
+ throw({error, invalid_input, RestData});
+ Result ->
+ Result
+ end.
+
+
+%% Flatten input list
+flatten_list([], _) ->
+ [];
+flatten_list(L, InEnc) ->
+ flatten_list(L, InEnc, []).
+%%
+flatten_list([H|T], InEnc, Acc) when is_binary(H) ->
+ L = convert_to_list(H, InEnc),
+ flatten_list(T, InEnc, lists:reverse(L) ++ Acc);
+flatten_list([H|T], InEnc, Acc) when is_list(H) ->
+ flatten_list(H ++ T, InEnc, Acc);
+flatten_list([H|T], InEnc, Acc) ->
+ flatten_list(T, InEnc, [H|Acc]);
+flatten_list([], _InEnc, Acc) ->
+ lists:reverse(Acc);
+flatten_list(Arg, _, _) ->
+ throw({error, invalid_input, Arg}).
+
+
+percent_encode_segment(Segment) ->
+ percent_encode_binary(Segment, <<>>).
+
+
+%%-------------------------------------------------------------------------
+%% Helper functions for compose_query
+%%-------------------------------------------------------------------------
+
+%% Returns separator to be used between key-value pairs
+get_separator(L) when length(L) =:= 0 ->
+ <<>>;
+get_separator(_L) ->
+ <<"&">>.
+
+
+%% HTML 5.2 - 4.10.21.6 URL-encoded form data - WHATWG URL (10 Jan 2018) - UTF-8
+%% HTML 5.0 - 4.10.22.6 URL-encoded form data - encoding (non UTF-8)
+form_urlencode(Cs, [{encoding, latin1}]) when is_list(Cs) ->
+ B = convert_to_binary(Cs, utf8, utf8),
+ html5_byte_encode(base10_encode(B));
+form_urlencode(Cs, [{encoding, latin1}]) when is_binary(Cs) ->
+ html5_byte_encode(base10_encode(Cs));
+form_urlencode(Cs, [{encoding, Encoding}])
+ when is_list(Cs), Encoding =:= utf8; Encoding =:= unicode ->
+ B = convert_to_binary(Cs, utf8, Encoding),
+ html5_byte_encode(B);
+form_urlencode(Cs, [{encoding, Encoding}])
+ when is_binary(Cs), Encoding =:= utf8; Encoding =:= unicode ->
+ html5_byte_encode(Cs);
+form_urlencode(Cs, [{encoding, Encoding}]) when is_list(Cs); is_binary(Cs) ->
+ throw({error,invalid_encoding, Encoding});
+form_urlencode(Cs, _) ->
+ throw({error,invalid_input, Cs}).
+
+
+%% For each character in the entry's name and value that cannot be expressed using
+%% the selected character encoding, replace the character by a string consisting of
+%% a U+0026 AMPERSAND character (&), a "#" (U+0023) character, one or more ASCII
+%% digits representing the Unicode code point of the character in base ten, and
+%% finally a ";" (U+003B) character.
+base10_encode(Cs) ->
+ base10_encode(Cs, <<>>).
+%%
+base10_encode(<<>>, Acc) ->
+ Acc;
+base10_encode(<<H/utf8,T/binary>>, Acc) when H > 255 ->
+ Base10 = convert_to_binary(integer_to_list(H,10), utf8, utf8),
+ base10_encode(T, <<Acc/binary,"&#",Base10/binary,$;>>);
+base10_encode(<<H/utf8,T/binary>>, Acc) ->
+ base10_encode(T, <<Acc/binary,H>>).
+
+
+html5_byte_encode(B) ->
+ html5_byte_encode(B, <<>>).
+%%
+html5_byte_encode(<<>>, Acc) ->
+ Acc;
+html5_byte_encode(<<$ ,T/binary>>, Acc) ->
+ html5_byte_encode(T, <<Acc/binary,$+>>);
+html5_byte_encode(<<H,T/binary>>, Acc) ->
+ case is_url_char(H) of
+ true ->
+ html5_byte_encode(T, <<Acc/binary,H>>);
+ false ->
+ <<A:4,B:4>> = <<H>>,
+ html5_byte_encode(T, <<Acc/binary,$%,(?DEC2HEX(A)),(?DEC2HEX(B))>>)
+ end;
+html5_byte_encode(H, _Acc) ->
+ throw({error,invalid_input, H}).
+
+
+%% Return true if input char can appear in form-urlencoded string
+%% Allowed chararacters:
+%% 0x2A, 0x2D, 0x2E, 0x30 to 0x39, 0x41 to 0x5A,
+%% 0x5F, 0x61 to 0x7A
+is_url_char(C)
+ when C =:= 16#2A; C =:= 16#2D;
+ C =:= 16#2E; C =:= 16#5F;
+ 16#30 =< C, C =< 16#39;
+ 16#41 =< C, C =< 16#5A;
+ 16#61 =< C, C =< 16#7A -> true;
+is_url_char(_) -> false.
+
+
+%%-------------------------------------------------------------------------
+%% Helper functions for dissect_query
+%%-------------------------------------------------------------------------
+dissect_query_key(<<$=,T/binary>>, IsList, Acc, Key, Value) ->
+ dissect_query_value(T, IsList, Acc, Key, Value);
+dissect_query_key(<<"&#",T/binary>>, IsList, Acc, Key, Value) ->
+ dissect_query_key(T, IsList, Acc, <<Key/binary,"&#">>, Value);
+dissect_query_key(<<$&,_T/binary>>, _IsList, _Acc, _Key, _Value) ->
+ throw({error, missing_value, "&"});
+dissect_query_key(<<H,T/binary>>, IsList, Acc, Key, Value) ->
+ dissect_query_key(T, IsList, Acc, <<Key/binary,H>>, Value);
+dissect_query_key(B, _, _, _, _) ->
+ throw({error, missing_value, B}).
+
+
+dissect_query_value(<<$&,T/binary>>, IsList, Acc, Key, Value) ->
+ K = form_urldecode(IsList, Key),
+ V = form_urldecode(IsList, Value),
+ dissect_query_key(T, IsList, [{K,V}|Acc], <<>>, <<>>);
+dissect_query_value(<<H,T/binary>>, IsList, Acc, Key, Value) ->
+ dissect_query_value(T, IsList, Acc, Key, <<Value/binary,H>>);
+dissect_query_value(<<>>, IsList, Acc, Key, Value) ->
+ K = form_urldecode(IsList, Key),
+ V = form_urldecode(IsList, Value),
+ lists:reverse([{K,V}|Acc]).
+
+
+%% HTML 5.2 - 4.10.21.6 URL-encoded form data - WHATWG URL (10 Jan 2018) - UTF-8
+%% HTML 5.0 - 4.10.22.6 URL-encoded form data - decoding (non UTF-8)
+form_urldecode(true, B) ->
+ Result = base10_decode(form_urldecode(B, <<>>)),
+ convert_to_list(Result, utf8);
+form_urldecode(false, B) ->
+ base10_decode(form_urldecode(B, <<>>));
+form_urldecode(<<>>, Acc) ->
+ Acc;
+form_urldecode(<<$+,T/binary>>, Acc) ->
+ form_urldecode(T, <<Acc/binary,$ >>);
+form_urldecode(<<$%,C0,C1,T/binary>>, Acc) ->
+ case is_hex_digit(C0) andalso is_hex_digit(C1) of
+ true ->
+ V = ?HEX2DEC(C0)*16+?HEX2DEC(C1),
+ form_urldecode(T, <<Acc/binary, V>>);
+ false ->
+ L = convert_to_list(<<$%,C0,C1,T/binary>>, utf8),
+ throw({error, invalid_percent_encoding, L})
+ end;
+form_urldecode(<<H/utf8,T/binary>>, Acc) ->
+ form_urldecode(T, <<Acc/binary,H/utf8>>);
+form_urldecode(<<H,_/binary>>, _Acc) ->
+ throw({error, invalid_character, [H]}).
+
+base10_decode(Cs) ->
+ base10_decode(Cs, <<>>).
+%
+base10_decode(<<>>, Acc) ->
+ Acc;
+base10_decode(<<"&#",T/binary>>, Acc) ->
+ base10_decode_unicode(T, Acc);
+base10_decode(<<H/utf8,T/binary>>, Acc) ->
+ base10_decode(T,<<Acc/binary,H/utf8>>);
+base10_decode(<<H,_/binary>>, _) ->
+ throw({error, invalid_input, [H]}).
+
+
+base10_decode_unicode(B, Acc) ->
+ base10_decode_unicode(B, 0, Acc).
+%%
+base10_decode_unicode(<<H/utf8,T/binary>>, Codepoint, Acc) when $0 =< H, H =< $9 ->
+ Res = Codepoint * 10 + (H - $0),
+ base10_decode_unicode(T, Res, Acc);
+base10_decode_unicode(<<$;,T/binary>>, Codepoint, Acc) ->
+ base10_decode(T, <<Acc/binary,Codepoint/utf8>>);
+base10_decode_unicode(<<H,_/binary>>, _, _) ->
+ throw({error, invalid_input, [H]}).
+
+
+%%-------------------------------------------------------------------------
+%% Helper functions for normalize
+%%-------------------------------------------------------------------------
+
+normalize_map(URIMap) ->
+ normalize_path_segment(
+ normalize_scheme_based(
+ normalize_percent_encoding(
+ normalize_case(URIMap)))).
+
+
+%% 6.2.2.1. Case Normalization
+normalize_case(#{scheme := Scheme, host := Host} = Map) ->
+ Map#{scheme => to_lower(Scheme),
+ host => to_lower(Host)};
+normalize_case(#{host := Host} = Map) ->
+ Map#{host => to_lower(Host)};
+normalize_case(#{scheme := Scheme} = Map) ->
+ Map#{scheme => to_lower(Scheme)};
+normalize_case(#{} = Map) ->
+ Map.
+
+
+%% 6.2.2.2. Percent-Encoding Normalization
+normalize_percent_encoding(Map) ->
+ Fun = fun (K,V) when K =:= userinfo; K =:= host; K =:= path;
+ K =:= query; K =:= fragment ->
+ decode(V);
+ %% Handle port and scheme
+ (_,V) ->
+ V
+ end,
+ maps:map(Fun, Map).
+
+
+to_lower(Cs) when is_list(Cs) ->
+ B = convert_to_binary(Cs, utf8, utf8),
+ convert_to_list(to_lower(B), utf8);
+to_lower(Cs) when is_binary(Cs) ->
+ to_lower(Cs, <<>>).
+%%
+to_lower(<<C,Cs/binary>>, Acc) when $A =< C, C =< $Z ->
+ to_lower(Cs, <<Acc/binary,(C + 32)>>);
+to_lower(<<C,Cs/binary>>, Acc) ->
+ to_lower(Cs, <<Acc/binary,C>>);
+to_lower(<<>>, Acc) ->
+ Acc.
+
+
+%% 6.2.2.3. Path Segment Normalization
+%% 5.2.4. Remove Dot Segments
+normalize_path_segment(Map) ->
+ Path = maps:get(path, Map, undefined),
+ Map#{path => remove_dot_segments(Path)}.
+
+
+remove_dot_segments(Path) when is_binary(Path) ->
+ remove_dot_segments(Path, <<>>);
+remove_dot_segments(Path) when is_list(Path) ->
+ B = convert_to_binary(Path, utf8, utf8),
+ B1 = remove_dot_segments(B, <<>>),
+ convert_to_list(B1, utf8).
+%%
+remove_dot_segments(<<>>, Output) ->
+ Output;
+remove_dot_segments(<<"../",T/binary>>, Output) ->
+ remove_dot_segments(T, Output);
+remove_dot_segments(<<"./",T/binary>>, Output) ->
+ remove_dot_segments(T, Output);
+remove_dot_segments(<<"/./",T/binary>>, Output) ->
+ remove_dot_segments(<<$/,T/binary>>, Output);
+remove_dot_segments(<<"/.">>, Output) ->
+ remove_dot_segments(<<$/>>, Output);
+remove_dot_segments(<<"/../",T/binary>>, Output) ->
+ Out1 = remove_last_segment(Output),
+ remove_dot_segments(<<$/,T/binary>>, Out1);
+remove_dot_segments(<<"/..">>, Output) ->
+ Out1 = remove_last_segment(Output),
+ remove_dot_segments(<<$/>>, Out1);
+remove_dot_segments(<<$.>>, Output) ->
+ remove_dot_segments(<<>>, Output);
+remove_dot_segments(<<"..">>, Output) ->
+ remove_dot_segments(<<>>, Output);
+remove_dot_segments(Input, Output) ->
+ {First, Rest} = first_path_segment(Input),
+ remove_dot_segments(Rest, <<Output/binary,First/binary>>).
+
+
+first_path_segment(Input) ->
+ F = first_path_segment(Input, <<>>),
+ split_binary(Input, byte_size(F)).
+%%
+first_path_segment(<<$/,T/binary>>, Acc) ->
+ first_path_segment_end(<<T/binary>>, <<Acc/binary,$/>>);
+first_path_segment(<<C,T/binary>>, Acc) ->
+ first_path_segment_end(<<T/binary>>, <<Acc/binary,C>>).
+
+
+first_path_segment_end(<<>>, Acc) ->
+ Acc;
+first_path_segment_end(<<$/,_/binary>>, Acc) ->
+ Acc;
+first_path_segment_end(<<C,T/binary>>, Acc) ->
+ first_path_segment_end(<<T/binary>>, <<Acc/binary,C>>).
+
+
+remove_last_segment(<<>>) ->
+ <<>>;
+remove_last_segment(B) ->
+ {Init, Last} = split_binary(B, byte_size(B) - 1),
+ case Last of
+ <<$/>> ->
+ Init;
+ _Char ->
+ remove_last_segment(Init)
+ end.
+
+
+%% RFC 3986, 6.2.3. Scheme-Based Normalization
+normalize_scheme_based(Map) ->
+ Scheme = maps:get(scheme, Map, undefined),
+ Port = maps:get(port, Map, undefined),
+ Path= maps:get(path, Map, undefined),
+ normalize_scheme_based(Map, Scheme, Port, Path).
+%%
+normalize_scheme_based(Map, Scheme, Port, Path)
+ when Scheme =:= "http"; Scheme =:= <<"http">> ->
+ normalize_http(Map, Port, Path);
+normalize_scheme_based(Map, Scheme, Port, Path)
+ when Scheme =:= "https"; Scheme =:= <<"https">> ->
+ normalize_https(Map, Port, Path);
+normalize_scheme_based(Map, Scheme, Port, _Path)
+ when Scheme =:= "ftp"; Scheme =:= <<"ftp">> ->
+ normalize_ftp(Map, Port);
+normalize_scheme_based(Map, Scheme, Port, _Path)
+ when Scheme =:= "ssh"; Scheme =:= <<"ssh">> ->
+ normalize_ssh_sftp(Map, Port);
+normalize_scheme_based(Map, Scheme, Port, _Path)
+ when Scheme =:= "sftp"; Scheme =:= <<"sftp">> ->
+ normalize_ssh_sftp(Map, Port);
+normalize_scheme_based(Map, Scheme, Port, _Path)
+ when Scheme =:= "tftp"; Scheme =:= <<"tftp">> ->
+ normalize_tftp(Map, Port);
+normalize_scheme_based(Map, _, _, _) ->
+ Map.
+
+
+normalize_http(Map, Port, Path) ->
+ M1 = normalize_port(Map, Port, 80),
+ normalize_http_path(M1, Path).
+
+
+normalize_https(Map, Port, Path) ->
+ M1 = normalize_port(Map, Port, 443),
+ normalize_http_path(M1, Path).
+
+
+normalize_ftp(Map, Port) ->
+ normalize_port(Map, Port, 21).
+
+
+normalize_ssh_sftp(Map, Port) ->
+ normalize_port(Map, Port, 22).
+
+
+normalize_tftp(Map, Port) ->
+ normalize_port(Map, Port, 69).
+
+
+normalize_port(Map, Port, Default) ->
+ case Port of
+ Default ->
+ maps:remove(port, Map);
+ _Else ->
+ Map
+ end.
+
+
+normalize_http_path(Map, Path) ->
+ case Path of
+ "" ->
+ Map#{path => "/"};
+ <<>> ->
+ Map#{path => <<"/">>};
+ _Else ->
+ Map
+ end.
diff --git a/lib/stdlib/src/zip.erl b/lib/stdlib/src/zip.erl
index 81f927f399..a922bf3fbe 100644
--- a/lib/stdlib/src/zip.erl
+++ b/lib/stdlib/src/zip.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2017. All Rights Reserved.
+%% Copyright Ericsson AB 2006-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -457,8 +457,7 @@ do_zip(F, Files, Options) ->
Out3 = Output({close, F}, Out2),
{ok, Out3}
catch
- C:R ->
- Stk = erlang:get_stacktrace(),
+ C:R:Stk ->
zlib:close(Z),
Output({close, F}, Out0),
erlang:raise(C, R, Stk)