Merge pull request #25 from basho/adt-faster-format

Faster string formatting

src/lager.erl

@@ -56,7 +56,7 @@ log(Level, Module, Function, Line, Pid, Time, Message) ->
     Timestamp = lager_util:format_time(Time),
     Msg = [["[", atom_to_list(Level), "] "],
            io_lib:format("~p@~p:~p:~p ", [Pid, Module, Function, Line]),
-           safe_format_chop("~s", [Message], 4096)],
+           safe_format_chop(Message, [], 4096)],
     safe_notify(lager_util:level_to_num(Level), Timestamp, Msg).
 
 %% @private
@@ -74,7 +74,7 @@ log(Level, Module, Function, Line, Pid, Time, Format, Args) ->
 log(Level, Pid, Message) ->
     Timestamp = lager_util:format_time(),
     Msg = [["[", atom_to_list(Level), "] "], io_lib:format("~p ", [Pid]),
-           safe_format_chop("~s", [Message], 4096)],
+           safe_format_chop(Message, [], 4096)],
     safe_notify(lager_util:level_to_num(Level), Timestamp, Msg).
 
 %% @doc Manually log a message into lager without using the parse transform.
@@ -147,7 +147,10 @@ safe_notify(Level, Timestamp, Msg) ->
 %% arguments. The caller is NOT crashed.
 
 safe_format(Fmt, Args, Limit) ->
-    try lager_trunc_io:format(Fmt, Args, Limit) of
+    safe_format(Fmt, Args, Limit, []).
+
+safe_format(Fmt, Args, Limit, Options) ->
+    try lager_trunc_io:format(Fmt, Args, Limit, Options) of
         Result -> Result
     catch
         _:_ -> lager_trunc_io:format("FORMAT ERROR: ~p ~p", [Fmt, Args], Limit)
@@ -155,4 +158,4 @@ safe_format(Fmt, Args, Limit) ->
 
 %% @private
 safe_format_chop(Fmt, Args, Limit) ->
-    re:replace(safe_format(Fmt, Args, Limit), "\n$", "", [{return, list}]).
+    safe_format(Fmt, Args, Limit, [{chomp, true}]).

src/lager_format.erl

@@ -0,0 +1,523 @@
+%%
+%% %CopyrightBegin%
+%% 
+%% Copyright Ericsson AB 1996-2011. All Rights Reserved.
+%% 
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%% 
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%% 
+%% %CopyrightEnd%
+%%
+-module(lager_format).
+
+%% fork of io_lib_format that uses trunc_io to protect against large terms
+
+-export([format/3, format/4]).
+
+-record(options, {
+        chomp = false
+    }).
+
+format(FmtStr, Args, MaxLen) ->
+    format(FmtStr, Args, MaxLen, []).
+
+format(FmtStr, Args, MaxLen, Opts) ->
+    Options = make_options(Opts, #options{}),
+    Cs = collect(FmtStr, Args),
+    {Cs2, MaxLen2} = build(Cs, [], MaxLen, Options),
+    %% count how many terms remain
+    {Count, StrLen} = lists:foldl(
+        fun({_C, _As, _F, _Adj, _P, _Pad, _Enc}, {Terms, Chars}) ->
+                {Terms + 1, Chars};
+            (_, {Terms, Chars}) ->
+                {Terms, Chars + 1}
+        end, {0, 0}, Cs2),
+    build2(Cs2, Count, MaxLen2 - StrLen).
+
+collect([$~|Fmt0], Args0) ->
+    {C,Fmt1,Args1} = collect_cseq(Fmt0, Args0),
+    [C|collect(Fmt1, Args1)];
+collect([C|Fmt], Args) ->
+    [C|collect(Fmt, Args)];
+collect([], []) -> [].
+
+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),
+    {C,As,Fmt5,Args5} = collect_cc(Fmt4, Args4),
+    {{C,As,F,Ad,P,Pad,Encoding},Fmt5,Args5}.
+
+encoding([$t|Fmt],Args) ->
+    {unicode,Fmt,Args};
+encoding(Fmt,Args) ->
+    {latin1,Fmt,Args}.
+
+field_width([$-|Fmt0], Args0) ->
+    {F,Fmt,Args} = field_value(Fmt0, Args0),
+    field_width(-F, Fmt, Args);
+field_width(Fmt0, Args0) ->
+    {F,Fmt,Args} = field_value(Fmt0, Args0),
+    field_width(F, Fmt, Args).
+
+field_width(F, Fmt, Args) when F < 0 ->
+    {-F,left,Fmt,Args};
+field_width(F, Fmt, Args) when F >= 0 ->
+    {F,right,Fmt,Args}.
+
+precision([$.|Fmt], Args) ->
+    field_value(Fmt, Args);
+precision(Fmt, Args) ->
+    {none,Fmt,Args}.
+
+field_value([$*|Fmt], [A|Args]) when is_integer(A) ->
+    {A,Fmt,Args};
+field_value([C|Fmt], Args) when is_integer(C), C >= $0, C =< $9 ->
+    field_value([C|Fmt], Args, 0);
+field_value(Fmt, Args) ->
+    {none,Fmt,Args}.
+
+field_value([C|Fmt], Args, F) when is_integer(C), C >= $0, C =< $9 ->
+    field_value(Fmt, Args, 10*F + (C - $0));
+field_value(Fmt, Args, F) ->		%Default case
+    {F,Fmt,Args}.
+
+pad_char([$.,$*|Fmt], [Pad|Args]) -> {Pad,Fmt,Args};
+pad_char([$.,Pad|Fmt], Args) -> {Pad,Fmt,Args};
+pad_char(Fmt, Args) -> {$\s,Fmt,Args}.
+
+%% collect_cc([FormatChar], [Argument]) ->
+%%	{Control,[ControlArg],[FormatChar],[Arg]}.
+%%  Here we collect the argments for each control character.
+%%  Be explicit to cause failure early.
+
+collect_cc([$w|Fmt], [A|Args]) -> {$w,[A],Fmt,Args};
+collect_cc([$p|Fmt], [A|Args]) -> {$p,[A],Fmt,Args};
+collect_cc([$W|Fmt], [A,Depth|Args]) -> {$W,[A,Depth],Fmt,Args};
+collect_cc([$P|Fmt], [A,Depth|Args]) -> {$P,[A,Depth],Fmt,Args};
+collect_cc([$s|Fmt], [A|Args]) -> {$s,[A],Fmt,Args};
+collect_cc([$e|Fmt], [A|Args]) -> {$e,[A],Fmt,Args};
+collect_cc([$f|Fmt], [A|Args]) -> {$f,[A],Fmt,Args};
+collect_cc([$g|Fmt], [A|Args]) -> {$g,[A],Fmt,Args};
+collect_cc([$b|Fmt], [A|Args]) -> {$b,[A],Fmt,Args};
+collect_cc([$B|Fmt], [A|Args]) -> {$B,[A],Fmt,Args};
+collect_cc([$x|Fmt], [A,Prefix|Args]) -> {$x,[A,Prefix],Fmt,Args};
+collect_cc([$X|Fmt], [A,Prefix|Args]) -> {$X,[A,Prefix],Fmt,Args};
+collect_cc([$+|Fmt], [A|Args]) -> {$+,[A],Fmt,Args};
+collect_cc([$#|Fmt], [A|Args]) -> {$#,[A],Fmt,Args};
+collect_cc([$c|Fmt], [A|Args]) -> {$c,[A],Fmt,Args};
+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}.
+
+
+%% build([Control], Pc, Indentation) -> [Char].
+%%  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([{$n, _, _, _, _, _, _}], Acc, MaxLen, #options{chomp=true}) ->
+    %% trailing ~n, ignore
+    {lists:reverse(Acc), MaxLen};
+build([{C,As,F,Ad,P,Pad,Enc}|Cs], Acc, MaxLen, O) ->
+    {S, MaxLen2} = control(C, As, F, Ad, P, Pad, Enc, MaxLen),
+    build(Cs, [S|Acc], MaxLen2, O);
+build([$\n], Acc, MaxLen, #options{chomp=true}) ->
+    %% trailing \n, ignore
+    {lists:reverse(Acc), MaxLen};
+build([$\n|Cs], Acc, MaxLen, O) ->
+    build(Cs, [$\n|Acc], MaxLen - 1, O);
+build([$\t|Cs], Acc, MaxLen, O) ->
+    build(Cs, [$\t|Acc], MaxLen - 1, O);
+build([C|Cs], Acc, MaxLen, O) ->
+    build(Cs, [C|Acc], MaxLen - 1, O);
+build([], Acc, MaxLen, _O) ->
+    {lists:reverse(Acc), MaxLen}.
+
+build2([{C,As,F,Ad,P,Pad,Enc}|Cs], Count, MaxLen) ->
+    {S, Len} = control2(C, As, F, Ad, P, Pad, Enc, MaxLen div Count),
+    [S|build2(Cs, Count - 1, MaxLen - abs(Len))];
+build2([C|Cs], Count, MaxLen) ->
+    [C|build2(Cs, Count, MaxLen)];
+build2([], _, _) -> [].
+
+%% control(FormatChar, [Argument], FieldWidth, Adjust, Precision, PadChar,
+%%	   Indentation) ->
+%%	[Char]
+%%  This is the main dispatch function for the various formatting commands.
+%%  Field widths and precisions have already been calculated.
+
+control($e, [A], F, Adj, P, Pad, _Enc, L) when is_float(A) ->
+    Res = fwrite_e(A, F, Adj, P, Pad),
+    {Res, L - lists:flatlength(Res)};
+control($f, [A], F, Adj, P, Pad, _Enc, L) when is_float(A) ->
+    Res = fwrite_f(A, F, Adj, P, Pad),
+    {Res, L - lists:flatlength(Res)};
+control($g, [A], F, Adj, P, Pad, _Enc, L) when is_float(A) ->
+    Res = fwrite_g(A, F, Adj, P, Pad),
+    {Res, L - lists:flatlength(Res)};
+control($b, [A], F, Adj, P, Pad, _Enc, L) when is_integer(A) ->
+    Res = unprefixed_integer(A, F, Adj, base(P), Pad, true),
+    {Res, L - lists:flatlength(Res)};
+control($B, [A], F, Adj, P, Pad, _Enc, L) when is_integer(A) ->
+    Res = unprefixed_integer(A, F, Adj, base(P), Pad, false),
+    {Res, L - lists:flatlength(Res)};
+control($x, [A,Prefix], F, Adj, P, Pad, _Enc, L) when is_integer(A), 
+                                                 is_atom(Prefix) ->
+    Res = prefixed_integer(A, F, Adj, base(P), Pad, atom_to_list(Prefix), true),
+    {Res, L - lists:flatlength(Res)};
+control($x, [A,Prefix], F, Adj, P, Pad, _Enc, L) when is_integer(A) ->
+    true = io_lib:deep_char_list(Prefix), %Check if Prefix a character list
+    Res = prefixed_integer(A, F, Adj, base(P), Pad, Prefix, true),
+    {Res, L - lists:flatlength(Res)};
+control($X, [A,Prefix], F, Adj, P, Pad, _Enc, L) when is_integer(A), 
+                                                 is_atom(Prefix) ->
+    Res = prefixed_integer(A, F, Adj, base(P), Pad, atom_to_list(Prefix), false),
+    {Res, L - lists:flatlength(Res)};
+control($X, [A,Prefix], F, Adj, P, Pad, _Enc, L) when is_integer(A) ->
+    true = io_lib:deep_char_list(Prefix), %Check if Prefix a character list
+    Res = prefixed_integer(A, F, Adj, base(P), Pad, Prefix, false),
+    {Res, L - lists:flatlength(Res)};
+control($+, [A], F, Adj, P, Pad, _Enc, L) when is_integer(A) ->
+    Base = base(P),
+    Prefix = [integer_to_list(Base), $#],
+    Res = prefixed_integer(A, F, Adj, Base, Pad, Prefix, true),
+    {Res, L - lists:flatlength(Res)};
+control($#, [A], F, Adj, P, Pad, _Enc, L) when is_integer(A) ->
+    Base = base(P),
+    Prefix = [integer_to_list(Base), $#],
+    Res = prefixed_integer(A, F, Adj, Base, Pad, Prefix, false),
+    {Res, L - lists:flatlength(Res)};
+control($c, [A], F, Adj, P, Pad, unicode, L) when is_integer(A) ->
+    Res = char(A, F, Adj, P, Pad),
+    {Res, L - lists:flatlength(Res)};
+control($c, [A], F, Adj, P, Pad, _Enc, L) when is_integer(A) ->
+    Res = char(A band 255, F, Adj, P, Pad),
+    {Res, L - lists:flatlength(Res)};
+control($~, [], F, Adj, P, Pad, _Enc, L) ->
+    Res = char($~, F, Adj, P, Pad),
+    {Res, L - lists:flatlength(Res)};
+control($n, [], F, Adj, P, Pad, _Enc, L) ->
+    Res = newline(F, Adj, P, Pad),
+    {Res, L - lists:flatlength(Res)};
+control($i, [_A], _F, _Adj, _P, _Pad, _Enc, L) ->
+    {[], L};
+control($s, [A], F, Adj, P, Pad, _Enc, L) when is_atom(A) ->
+    Res = string(atom_to_list(A), F, Adj, P, Pad),
+    {Res, L - lists:flatlength(Res)};
+control(C, A, F, Adj, P, Pad, Enc, L) ->
+    %% save this for later - these are all the 'large' terms
+    {{C, A, F, Adj, P, Pad, Enc}, L}.
+
+control2($w, [A], F, Adj, P, Pad, _Enc, L) ->
+    Term = lager_trunc_io:fprint(A, L, [{lists_as_strings, false}]),
+    Res = term(Term, F, Adj, P, Pad),
+    {Res, L - lists:flatlength(Res)};
+control2($p, [A], F, Adj, P, Pad, _Enc, L) ->
+    Term = lager_trunc_io:fprint(A, L, [{lists_as_strings, true}]),
+    Res = term(Term, F, Adj, P, Pad),
+    {Res, L - lists:flatlength(Res)};
+control2($W, [A,Depth], F, Adj, P, Pad, _Enc, L) when is_integer(Depth) ->
+    Term = lager_trunc_io:fprint(A, L, [{depth, Depth}, {lists_as_strings, false}]),
+    Res = term(Term, F, Adj, P, Pad),
+    {Res, L - lists:flatlength(Res)};
+control2($P, [A,Depth], F, Adj, P, Pad, _Enc, L) when is_integer(Depth) ->
+    Term = lager_trunc_io:fprint(A, L, [{depth, Depth}, {lists_as_strings, true}]),
+    Res = term(Term, F, Adj, P, Pad),
+    {Res, L - lists:flatlength(Res)};
+control2($s, [L0], F, Adj, P, Pad, latin1, L) ->
+    List = lager_trunc_io:fprint(maybe_flatten(L0), L, [{force_strings, true}]),
+    Res = string(List, F, Adj, P, Pad),
+    {Res, L - lists:flatlength(Res)};
+control2($s, [L0], F, Adj, P, Pad, unicode, L) ->
+    List = lager_trunc_io:fprint(unicode:characters_to_list(L0), L, [{force_strings, true}]),
+    Res = uniconv(string(List, F, Adj, P, Pad)),
+    {Res, L - lists:flatlength(Res)}.
+
+maybe_flatten(X) when is_list(X) ->
+    lists:flatten(X);
+maybe_flatten(X) ->
+    X.
+
+make_options([], Options) ->
+    Options;
+make_options([{chomp, Bool}|T], Options) when is_boolean(Bool) ->
+    make_options(T, Options#options{chomp=Bool}).
+
+-ifdef(UNICODE_AS_BINARIES).
+uniconv(C) ->
+    unicode:characters_to_binary(C,unicode).
+-else.
+uniconv(C) ->
+    C.
+-endif.
+%% Default integer base
+base(none) ->
+    10;
+base(B) when is_integer(B) ->
+    B.
+
+%% term(TermList, Field, Adjust, Precision, PadChar)
+%%  Output the characters in a term.
+%%  Adjust the characters within the field if length less than Max padding
+%%  with PadChar.
+
+term(T, none, _Adj, none, _Pad) -> T;
+term(T, none, Adj, P, Pad) -> term(T, P, Adj, P, Pad);
+term(T, F, Adj, P0, Pad) ->
+    L = lists:flatlength(T),
+    P = case P0 of none -> erlang:min(L, F); _ -> P0 end,
+    if
+	L > P ->
+	    adjust(chars($*, P), chars(Pad, F-P), Adj);
+	F >= P ->
+	    adjust(T, chars(Pad, F-L), Adj)
+    end.
+
+%% fwrite_e(Float, Field, Adjust, Precision, PadChar)
+
+fwrite_e(Fl, none, Adj, none, Pad) ->		%Default values
+    fwrite_e(Fl, none, Adj, 6, Pad);
+fwrite_e(Fl, none, _Adj, P, _Pad) when P >= 2 ->
+    float_e(Fl, float_data(Fl), P);
+fwrite_e(Fl, F, Adj, none, Pad) ->
+    fwrite_e(Fl, F, Adj, 6, Pad);
+fwrite_e(Fl, F, Adj, P, Pad) when P >= 2 ->
+    term(float_e(Fl, float_data(Fl), P), F, Adj, F, Pad).
+
+float_e(Fl, Fd, P) when Fl < 0.0 ->		%Negative numbers
+    [$-|float_e(-Fl, Fd, P)];
+float_e(_Fl, {Ds,E}, P) ->
+    case float_man(Ds, 1, P-1) of
+	{[$0|Fs],true} -> [[$1|Fs]|float_exp(E)];
+	{Fs,false} -> [Fs|float_exp(E-1)]
+    end.
+
+%% float_man([Digit], Icount, Dcount) -> {[Chars],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.
+
+float_man(Ds, 0, Dc) ->
+    {Cs,C} = float_man(Ds, Dc),
+    {[$.|Cs],C};
+float_man([D|Ds], I, Dc) ->
+    case float_man(Ds, I-1, Dc) of
+	{Cs,true} when D =:= $9 -> {[$0|Cs],true};
+	{Cs,true} -> {[D+1|Cs],false};
+	{Cs,false} -> {[D|Cs],false}
+    end;
+float_man([], I, Dc) ->				%Pad with 0's
+    {string:chars($0, I, [$.|string:chars($0, Dc)]),false}.
+
+float_man([D|_], 0) when D >= $5 -> {[],true};
+float_man([_|_], 0) -> {[],false};
+float_man([D|Ds], Dc) ->
+    case float_man(Ds, Dc-1) of
+	{Cs,true} when D =:= $9 -> {[$0|Cs],true};
+	{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_exp(Exponent) -> [Char].
+%%  Generate the exponent of a floating point number. Always include sign.
+
+float_exp(E) when E >= 0 ->
+    [$e,$+|integer_to_list(E)];
+float_exp(E) ->
+    [$e|integer_to_list(E)].
+
+%% fwrite_f(FloatData, Field, Adjust, Precision, PadChar)
+
+fwrite_f(Fl, none, Adj, none, Pad) ->		%Default values
+    fwrite_f(Fl, none, Adj, 6, Pad);
+fwrite_f(Fl, none, _Adj, P, _Pad) when P >= 1 ->
+    float_f(Fl, float_data(Fl), P);
+fwrite_f(Fl, F, Adj, none, Pad) ->
+    fwrite_f(Fl, F, Adj, 6, Pad);
+fwrite_f(Fl, F, Adj, P, Pad) when P >= 1 ->
+    term(float_f(Fl, float_data(Fl), P), F, Adj, F, Pad).
+
+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, {Ds,E}, P) ->
+    case float_man(Ds, E, P) of
+	{Fs,true} -> "1" ++ Fs;			%Handle carry
+	{Fs,false} -> Fs
+    end.
+
+%% float_data([FloatChar]) -> {[Digit],Exponent}
+
+float_data(Fl) ->
+    float_data(float_to_list(Fl), []).
+
+float_data([$e|E], Ds) ->
+    {lists:reverse(Ds),list_to_integer(E)+1};
+float_data([D|Cs], Ds) when D >= $0, D =< $9 ->
+    float_data(Cs, [D|Ds]);
+float_data([_|Cs], Ds) ->
+    float_data(Cs, Ds).
+
+%% fwrite_g(Float, Field, Adjust, Precision, PadChar)
+%%  Use the f form if Float is >= 0.1 and < 1.0e4, 
+%%  and the prints correctly in the f form, else the e form.
+%%  Precision always means the # of significant digits.
+
+fwrite_g(Fl, F, Adj, none, Pad) ->
+    fwrite_g(Fl, F, Adj, 6, Pad);
+fwrite_g(Fl, F, Adj, P, Pad) when P >= 1 ->
+    A = abs(Fl),
+    E = if A < 1.0e-1 -> -2;
+	   A < 1.0e0  -> -1;
+	   A < 1.0e1  -> 0;
+	   A < 1.0e2  -> 1;
+	   A < 1.0e3  -> 2;
+	   A < 1.0e4  -> 3;
+	   true       -> fwrite_f
+	end,
+    if  P =< 1, E =:= -1;
+	P-1 > E, E >= -1 ->
+	    fwrite_f(Fl, F, Adj, P-1-E, Pad);
+	P =< 1 ->
+	    fwrite_e(Fl, F, Adj, 2, Pad);
+	true ->
+	    fwrite_e(Fl, F, Adj, P, Pad)
+    end.
+
+
+%% string(String, Field, Adjust, Precision, PadChar)
+
+string(S, none, _Adj, none, _Pad) -> S;
+string(S, F, Adj, none, Pad) ->
+    string_field(S, F, Adj, lists:flatlength(S), Pad);
+string(S, none, _Adj, P, Pad) ->
+    string_field(S, P, left, lists:flatlength(S), Pad);
+string(S, F, Adj, P, Pad) when F >= P ->
+    N = lists:flatlength(S),
+    if F > P ->
+	    if N > P ->
+		    adjust(flat_trunc(S, P), chars(Pad, F-P), Adj);
+	       N < P ->
+		    adjust([S|chars(Pad, P-N)], chars(Pad, F-P), Adj);
+	       true -> % N == P
+		    adjust(S, chars(Pad, F-P), Adj)
+	    end;
+       true -> % F == P
+	    string_field(S, F, Adj, N, Pad)
+    end.
+
+string_field(S, F, _Adj, N, _Pad) when N > F ->
+    flat_trunc(S, F);
+string_field(S, F, Adj, N, Pad) when N < F ->
+    adjust(S, chars(Pad, F-N), Adj);
+string_field(S, _, _, _, _) -> % N == F
+    S.
+
+%% unprefixed_integer(Int, Field, Adjust, Base, PadChar, Lowercase)
+%% -> [Char].
+
+unprefixed_integer(Int, F, Adj, Base, Pad, Lowercase)
+  when Base >= 2, Base =< 1+$Z-$A+10 ->
+    if Int < 0 ->
+	    S = cond_lowercase(erlang:integer_to_list(-Int, Base), Lowercase),
+	    term([$-|S], F, Adj, none, Pad);
+       true ->
+	    S = cond_lowercase(erlang:integer_to_list(Int, Base), Lowercase),
+	    term(S, F, Adj, none, Pad)
+    end.
+
+%% prefixed_integer(Int, Field, Adjust, Base, PadChar, Prefix, Lowercase)
+%% -> [Char].
+
+prefixed_integer(Int, F, Adj, Base, Pad, Prefix, Lowercase)
+  when Base >= 2, Base =< 1+$Z-$A+10 ->
+    if Int < 0 ->
+	    S = cond_lowercase(erlang:integer_to_list(-Int, Base), Lowercase),
+	    term([$-,Prefix|S], F, Adj, none, Pad);
+       true ->
+	    S = cond_lowercase(erlang:integer_to_list(Int, Base), Lowercase),
+	    term([Prefix|S], F, Adj, none, Pad)
+    end.
+
+%% char(Char, Field, Adjust, Precision, PadChar) -> [Char].
+
+char(C, none, _Adj, none, _Pad) -> [C];
+char(C, F, _Adj, none, _Pad) -> chars(C, F);
+char(C, none, _Adj, P, _Pad) -> chars(C, P);
+char(C, F, Adj, P, Pad) when F >= P ->
+    adjust(chars(C, P), chars(Pad, F - P), Adj).
+
+%% newline(Field, Adjust, Precision, PadChar) -> [Char].
+
+newline(none, _Adj, _P, _Pad) -> "\n";
+newline(F, right, _P, _Pad) -> chars($\n, F).
+
+%%
+%% Utilities
+%%
+
+adjust(Data, [], _) -> Data;
+adjust(Data, Pad, left) -> [Data|Pad];
+adjust(Data, Pad, right) -> [Pad|Data].
+
+%% Flatten and truncate a deep list to at most N elements.
+
+flat_trunc(List, N) when is_integer(N), N >= 0 ->
+    flat_trunc(List, N, [], []).
+
+flat_trunc(L, 0, _, R) when is_list(L) ->
+    lists:reverse(R);
+flat_trunc([H|T], N, S, R) when is_list(H) ->
+    flat_trunc(H, N, [T|S], R);
+flat_trunc([H|T], N, S, R) ->
+    flat_trunc(T, N-1, S, [H|R]);
+flat_trunc([], N, [H|S], R) ->
+    flat_trunc(H, N, S, R);
+flat_trunc([], _, [], R) ->
+    lists:reverse(R).
+
+%% A deep version of string:chars/2,3
+
+chars(_C, 0) ->
+    [];
+chars(C, 1) ->
+    [C];
+chars(C, 2) ->
+    [C,C];
+chars(C, 3) ->
+    [C,C,C];
+chars(C, N) when is_integer(N), (N band 1) =:= 0 ->
+    S = chars(C, N bsr 1),
+    [S|S];
+chars(C, N) when is_integer(N) ->
+    S = chars(C, N bsr 1),
+    [C,S|S].
+
+%chars(C, N, Tail) ->
+%    [chars(C, N)|Tail].
+
+%% Lowercase conversion
+
+cond_lowercase(String, true) ->
+    lowercase(String);
+cond_lowercase(String,false) ->
+    String.
+
+lowercase([H|T]) when is_integer(H), H >= $A, H =< $Z ->
+    [(H-$A+$a)|lowercase(T)];
+lowercase([H|T]) ->
+    [H|lowercase(T)];
+lowercase([]) ->
+    [].

src/lager_handler_watcher.erl

@@ -110,7 +110,7 @@ reinstall_on_initial_failure_test_() ->
                     try
                       ?assertEqual(1, lager_test_backend:count()),
                       {_Level, _Time, [_, _, Message]} = lager_test_backend:pop(),
-                      ?assertMatch("Lager failed to install handler lager_crash_backend into lager_event, retrying later :"++_, Message),
+                      ?assertMatch("Lager failed to install handler lager_crash_backend into lager_event, retrying later :"++_, lists:flatten(Message)),
                       ?assertEqual(0, lager_test_backend:count()),
                       timer:sleep(6000),
                       ?assertEqual(0, lager_test_backend:count()),
@@ -139,9 +139,9 @@ reinstall_on_runtime_failure_test_() ->
                         timer:sleep(6000),
                         ?assertEqual(2, lager_test_backend:count()),
                         {_Level, _Time, [_, _, Message]} = lager_test_backend:pop(),
-                        ?assertEqual("Lager event handler lager_crash_backend exited with reason crash", Message),
+                        ?assertEqual("Lager event handler lager_crash_backend exited with reason crash", lists:flatten(Message)),
                         {_Level2, _Time2, [_, _, Message2]} = lager_test_backend:pop(),
-                        ?assertMatch("Lager failed to install handler lager_crash_backend into lager_event, retrying later :"++_, Message2),
+                        ?assertMatch("Lager failed to install handler lager_crash_backend into lager_event, retrying later :"++_, lists:flatten(Message2)),
                         ?assertEqual(false, lists:member(lager_crash_backend, gen_event:which_handlers(lager_event)))
                     after
                        application:stop(lager),

src/lager_trunc_io.erl

@@ -33,7 +33,7 @@
 -module(lager_trunc_io).
 -author('matthias@corelatus.se').
 %% And thanks to Chris Newcombe for a bug fix 
--export([format/3, print/2, fprint/2, safe/2]).               % interface functions
+-export([format/3, format/4, print/2, print/3, fprint/2, fprint/3, safe/2]). % interface functions
 -version("$Id: trunc_io.erl,v 1.11 2009-02-23 12:01:06 matthias Exp $").
 
 -ifdef(TEST).
@@ -41,149 +41,39 @@
 -include_lib("eunit/include/eunit.hrl").
 -endif.
 
-format(String, Args, Max) ->
-    Parts = re:split(String,
-        "(~(?:-??\\d+\\.|\\*\\.|\\.|)(?:-??\\d+\\.|\\*\\.|\\.|)(?:-??\\d+|\\*|)(?:t|)(?:[cfegswpWPBX#bx+ni~]))",
-        [{return, list}, trim]),
-    Maxlen = Max - length(String),
-    format(Parts, Args, Maxlen, [], []).
-
-format([], _Args, Max, Acc, ArgAcc) ->
-    FmtArgs = resolve_futures(Max, ArgAcc),
-    io_lib:format(lists:flatten(lists:reverse(Acc)), lists:reverse(FmtArgs));
-format([[] | T], Args, Max, Acc, ArgAcc) ->
-    % discard the null list generated by split
-    format(T, Args, Max, Acc, ArgAcc);
-format(["~~" | T], Args, Max, Acc, ArgAcc) ->
-    format(T, Args, Max+1, ["~~" | Acc], ArgAcc);
-format(["~n" | T], Args, Max, Acc, ArgAcc) ->
-    % ignore newlines for the purposes of argument indexing
-    format(T, Args, Max+1, ["~n" | Acc], ArgAcc);
-format(["~i" | T], [AH | AT], Max, Acc, ArgAcc) ->
-    % ~i means ignore this argument, but we'll just pass it through
-    format(T, AT, Max+2, ["~i" | Acc], [AH | ArgAcc]);
-format([[$~|H]| T], [AH1, AH2 | AT], Max, Acc, ArgAcc) when H == "X"; H == "x" ->
-    %% ~X consumes 2 arguments. It only prints integers so we can leave it alone
-    format(T, AT, Max, ["~X" | Acc], [AH2, AH1 | ArgAcc]);
-format([[$~|H]| T], [AH1, _AH2 | AT], Max, Acc, ArgAcc) when H == "W"; H == "P" ->
-    %% ~P and ~W consume 2 arguments, the second one being a depth limiter.
-    %% trunc_io isn't (yet) depth aware, so we can't honor this format string
-    %% safely at the moment, so just treat it like a regular ~p
-    %% TODO support for depth limiting
-    Input = case H == "P" andalso lager_stdlib:string_p(AH1) of
-        true ->
-            lists:flatten(AH1);
-        _ -> AH1
-    end,
-    case print(Input, Max + 2) of
-        {_Res, Max} ->
-            % this isn't the last argument, but it consumed all available space
-            % delay calculating the print size until the end
-            format(T, AT, Max + 2, ["~s" | Acc], [{future, Input} | ArgAcc]);
-        {String, Length} ->
-            format(T, AT, Max + 2 - Length, ["~s" | Acc], [String | ArgAcc])
-    end;
-format([[$~|H]| T], [AH | AT], Max, Acc, ArgAcc) when length(H) == 1 ->
-    % single character format specifier, relatively simple
-    case H of
-        _ when H == "p"; H == "w"; H == "s" ->
-            Input = case (H == "s" orelse H == "p") andalso lager_stdlib:string_p(AH) of
-                true ->
-                    lists:flatten(AH);
-                _ -> AH
-            end,
-            %okay, these are prime candidates for rewriting
-            case print(Input, Max + 2) of
-                {_Res, Max} ->
-                    % this isn't the last argument, but it consumed all available space
-                    % delay calculating the print size until the end
-                    format(T, AT, Max + 2, ["~s" | Acc], [{future, Input} | ArgAcc]);
-                {String, Length} ->
-                    {Value, RealLen} = case H of
-                        "s" ->
-                            % strip off the doublequotes, if applicable
-                            Trimmed = unquote_string(lists:flatten(String)),
-                            {Trimmed, length(Trimmed)};
-                        _ ->
-                            {String, Length}
-                    end,
-                    format(T, AT, Max + 2 - RealLen, ["~s" | Acc], [Value | ArgAcc])
-            end;
-        _ ->
-            % whatever, just pass them on through
-            format(T, AT, Max, [[$~ | H] | Acc], [AH | ArgAcc])
-    end;
-format([[$~|H]| T], [AH | AT], Max, Acc, ArgAcc) ->
-    %% its actually simplest to just look at the last character in the string
-    case lists:nth(length(H), H) of
-        C when C == $p; C == $w; C == $s ->
-            %okay, these are prime candidates for rewriting
-            Input = case (C == $s orelse C == $p) andalso lager_stdlib:string_p(AH) of
-                true ->
-                    lists:flatten(AH);
-                _ -> AH
-            end,
-            case print(Input, Max + length(H) + 1) of
-                {_Res, Max} ->
-                    % this isn't the last argument, but it consumed all available space
-                    % delay calculating the print size until the end
-                    format(T, AT, Max + length(H) + 1, ["~s" | Acc], [{future, Input} | ArgAcc]);
-                {String, Length} ->
-                    {Value, RealLen} = case C of
-                        $s ->
-                            % strip off the doublequotes, if applicable
-                            Trimmed = unquote_string(lists:flatten(String)),
-                            {Trimmed, length(Trimmed)};
-                        _ ->
-                            {String, Length}
-                    end,
-                    format(T, AT, Max + length(H) + 1 - RealLen, ["~s" | Acc], [Value | ArgAcc])
-            end;
-        C when C == $P; C == $W ->
-            %% ~P and ~W consume 2 arguments, the second one being a depth limiter.
-            %% trunc_io isn't (yet) depth aware, so we can't honor this format string
-            %% safely at the moment, so just treat it like a regular ~p
-            %% TODO support for depth limiting
-            [_ | AT2] = AT,
-            Input = case C == $P andalso lager_stdlib:string_p(AH) of
-                true ->
-                    lists:flatten(AH);
-                _ -> AH
-            end,
-            case print(Input, Max + 2) of
-                {_Res, Max} ->
-                    % this isn't the last argument, but it consumed all available space
-                    % delay calculating the print size until the end
-                    format(T, AT2, Max + 2, ["~s" | Acc], [{future, Input} | ArgAcc]);
-                {String, Length} ->
-                    format(T, AT2, Max + 2 - Length, ["~s" | Acc], [String | ArgAcc])
-            end;
-        C when C == $X; C == $x ->
-            %% ~X consumes 2 arguments. It only prints integers so we can leave it alone
-            [AH2 | AT2] = AT,
-            format(T, AT2, Max, [[$~|H]|Acc], [AH2, AH |ArgAcc]);
-        _ ->
-            format(T, AT, Max, [[$~|H] | Acc], [AH|ArgAcc])
-    end;
-format([H | T], Args, Max, Acc, ArgAcc) ->
-    format(T, Args, Max, [H | Acc], ArgAcc).
-
-%% for all the really big terms encountered in a format/3 call, try to give each of them an equal share
-resolve_futures(Max, Args) ->
-    Count = length(lists:filter(fun({future, _}) -> true; (_) -> false end, Args)),
-    case Count of
-        0 ->
-            Args;
-        _ ->
-            SingleFmt = Max div Count,
-            lists:map(fun({future, Value}) -> element(1, print(Value, SingleFmt)); (X) -> X end, Args)
+-record(print_options, {
+        %% negative depth means no depth limiting
+        depth = -1 :: integer(),
+        %% whether to print lists as strings, if possible
+        lists_as_strings = true :: boolean(),
+        %% force strings, or binaries to be printed as a string,
+        %% even if they're not printable
+        force_strings = false :: boolean()
+    }).
+
+format(Fmt, Args, Max) ->
+    format(Fmt, Args, Max, []).
+
+format(Fmt, Args, Max, Options) ->
+    try lager_format:format(Fmt, Args, Max, Options) of
+        Result -> Result
+    catch
+        _:_ ->
+            erlang:error(badarg, [Fmt, Args])
     end.
 
 %% @doc Returns an flattened list containing the ASCII representation of the given
 %% term.
 -spec fprint(term(), pos_integer()) -> string().
-fprint(T, Max) -> 
-    {L, _} = print(T, Max),
+fprint(Term, Max) ->
+    fprint(Term, Max, []).
+
+
+%% @doc Returns an flattened list containing the ASCII representation of the given
+%% term.
+-spec fprint(term(), pos_integer(), #print_options{}) -> string().
+fprint(T, Max, Options) -> 
+    {L, _} = print(T, Max, prepare_options(Options, #print_options{})),
     lists:flatten(L).
 
 %% @doc Same as print, but never crashes. 
@@ -204,9 +94,23 @@ safe(What, Len) ->
 
 %% @doc Returns {List, Length}
 -spec print(term(), pos_integer()) -> {iolist(), pos_integer()}.
-print(_, Max) when Max < 0 -> {"...", 3};
-print(Tuple, Max) when is_tuple(Tuple) -> 
-    {TC, Len} = tuple_contents(Tuple, Max-2),
+print(Term, Max) ->
+    print(Term, Max, []).
+
+%% @doc Returns {List, Length}
+-spec print(term(), pos_integer(), #print_options{}) -> {iolist(), pos_integer()}.
+print(Term, Max, Options) when is_list(Options) ->
+    %% need to convert the proplist to a record
+    print(Term, Max, prepare_options(Options, #print_options{}));
+
+print(Term, _Max, #print_options{force_strings=true}) when not is_list(Term), not is_binary(Term), not is_atom(Term) ->
+    erlang:error(badarg);
+
+print(_, Max, _Options) when Max < 0 -> {"...", 3};
+print(_, _, #print_options{depth=0}) -> {"...", 3};
+
+print(Tuple, Max, Options) when is_tuple(Tuple) -> 
+    {TC, Len} = tuple_contents(Tuple, Max-2, Options),
     {[${, TC, $}], Len + 2};
 
 %% @doc We assume atoms, floats, funs, integers, PIDs, ports and refs never need 
@@ -214,38 +118,49 @@ print(Tuple, Max) when is_tuple(Tuple) ->
 %% arbitrarily long bignum. Let's assume that won't happen unless someone
 %% is being malicious.
 %%
-print(Atom, _Max) when is_atom(Atom) ->
+print(Atom, _Max, #print_options{force_strings=NoQuote}) when is_atom(Atom) ->
     L = atom_to_list(Atom),
-    R = case atom_needs_quoting_start(L) of
+    R = case atom_needs_quoting_start(L) andalso not NoQuote of
         true -> lists:flatten([$', L, $']);
         false -> L
     end,
     {R, length(R)};
 
-print(<<>>, _Max) ->
+print(<<>>, _Max, _Options) ->
     {"<<>>", 4};
 
-print(Binary, 0) when is_binary(Binary) ->
+print(Binary, 0, _Options) when is_binary(Binary) ->
     {"<<..>>", 6};
 
-print(Binary, Max) when is_binary(Binary) ->
+print(Binary, Max, Options) when is_binary(Binary) ->
     B = binary_to_list(Binary, 1, lists:min([Max, size(Binary)])),
-    {L, Len} = alist_start(B, Max-4),
+    {L, Len} = case Options#print_options.lists_as_strings orelse
+        Options#print_options.force_strings of
+        true ->
+            alist_start(B, Max-4, Options);
+        _ ->
+            list_body(B, Max-4, Options, false)
+    end,
     {Res, Length} = case L of
         [91, X, 93] ->
             {X, Len - 2};
         X ->
             {X, Len}
     end,
-    {["<<", Res, ">>"], Length+4};
+    case Options#print_options.force_strings of
+        true ->
+            {Res, Length};
+        _ ->
+            {["<<", Res, ">>"], Length+4}
+    end;
 
-print(Float, _Max) when is_float(Float) ->
+print(Float, _Max, _Options) when is_float(Float) ->
     %% use the same function io_lib:format uses to print floats
     %% float_to_list is way too verbose.
     L = io_lib_format:fwrite_g(Float),
     {L, length(L)};
 
-print(Fun, Max) when is_function(Fun) ->
+print(Fun, Max, _Options) when is_function(Fun) ->
     L = erlang:fun_to_list(Fun),
     case length(L) > Max of
         true ->
@@ -256,50 +171,62 @@ print(Fun, Max) when is_function(Fun) ->
             {L, length(L)}
     end;
 
-print(Integer, _Max) when is_integer(Integer) ->
+print(Integer, _Max, _Options) when is_integer(Integer) ->
     L = integer_to_list(Integer),
     {L, length(L)};
 
-print(Pid, _Max) when is_pid(Pid) ->
+print(Pid, _Max, _Options) when is_pid(Pid) ->
     L = pid_to_list(Pid),
     {L, length(L)};
 
-print(Ref, _Max) when is_reference(Ref) ->
+print(Ref, _Max, _Options) when is_reference(Ref) ->
     L = erlang:ref_to_list(Ref),
     {L, length(L)};
 
-print(Port, _Max) when is_port(Port) ->
+print(Port, _Max, _Options) when is_port(Port) ->
     L = erlang:port_to_list(Port),
     {L, length(L)};
 
-print(List, Max) when is_list(List) ->
-    alist_start(List, Max).
+print(List, Max, Options) when is_list(List) ->
+    case Options#print_options.lists_as_strings orelse
+        Options#print_options.force_strings of
+        true ->
+            alist_start(List, Max, dec_depth(Options));
+        _ ->
+            {R, Len} = list_body(List, Max, dec_depth(Options), false),
+            {[$[, R, $]], Len + 2}
+    end.
 
 %% Returns {List, Length}
-tuple_contents(Tuple, Max) ->
+tuple_contents(Tuple, Max, Options) ->
     L = tuple_to_list(Tuple),
-    list_body(L, Max).
+    list_body(L, Max, dec_depth(Options), true).
 
 %% Format the inside of a list, i.e. do not add a leading [ or trailing ].
 %% Returns {List, Length}
-list_body([], _) -> {[], 0};
-list_body(_, Max) when Max < 4 -> {"...", 3};
-list_body([H|T], Max) -> 
-    {List, Len} = print(H, Max),
-    {Final, FLen} = list_bodyc(T, Max - Len),
+list_body([], _Max, _Options, _Tuple) -> {[], 0};
+list_body(_, Max, _Options, _Tuple) when Max < 4 -> {"...", 3};
+list_body(_, _Max, #print_options{depth=0}, _Tuple) -> {"...", 3};
+list_body([H|T], Max, Options, Tuple) -> 
+    {List, Len} = print(H, Max, Options),
+    {Final, FLen} = list_bodyc(T, Max - Len, Options, Tuple),
     {[List|Final], FLen + Len};
-list_body(X, Max) ->  %% improper list
-    {List, Len} = print(X, Max - 1),
+list_body(X, Max, Options, _Tuple) ->  %% improper list
+    {List, Len} = print(X, Max - 1, Options),
     {[$|,List], Len + 1}.
 
-list_bodyc([], _) -> {[], 0};
-list_bodyc(_, Max) when Max < 4 -> {"...", 3};
-list_bodyc([H|T], Max) -> 
-    {List, Len} = print(H, Max),
-    {Final, FLen} = list_bodyc(T, Max - Len - 1),
-    {[$,, List|Final], FLen + Len + 1};
-list_bodyc(X,Max) ->  %% improper list
-    {List, Len} = print(X, Max - 1),
+list_bodyc([], _Max, _Options, _Tuple) -> {[], 0};
+list_bodyc(_, Max, _Options, _Tuple) when Max < 4 -> {",...", 3};
+list_bodyc([H|T], Max, #print_options{depth=Depth} = Options, Tuple) -> 
+    {List, Len} = print(H, Max, dec_depth(Options)),
+    {Final, FLen} = list_bodyc(T, Max - Len - 1, Options, Tuple),
+    Sep = case Depth == 1 andalso not Tuple of
+        true -> $|;
+        _ -> $,
+    end,
+    {[Sep, List|Final], FLen + Len + 1};
+list_bodyc(X, Max, Options, _Tuple) ->  %% improper list
+    {List, Len} = print(X, Max - 1, Options),
     {[$|,List], Len + 1}.
 
 %% The head of a list we hope is ascii. Examples:
@@ -309,39 +236,55 @@ list_bodyc(X,Max) ->  %% improper list
 %% [0,65,66] -> [0,65,66]
 %% [65,b,66] -> "A"[b,66]
 %%
-alist_start([], _) -> {"[]", 2};
-alist_start(_, Max) when Max < 4 -> {"...", 3};
-alist_start([H|T], Max) when is_integer(H), H >= 16#20, H =< 16#7e ->  % definitely printable
-    try alist([H|T], Max -1) of
+alist_start([], _Max, #print_options{force_strings=true}) -> {"", 0};
+alist_start([], _Max, _Options) -> {"[]", 2};
+alist_start(_, Max, _Options) when Max < 4 -> {"...", 3};
+alist_start(_, _Max, #print_options{depth=0}) -> {"[...]", 3};
+alist_start(L, Max, #print_options{force_strings=true} = Options) ->
+    alist(L, Max, Options);
+alist_start([H|T], Max, Options) when is_integer(H), H >= 16#20, H =< 16#7e ->  % definitely printable
+    try alist([H|T], Max -1, Options) of
         {L, Len} ->
             {[$"|L], Len + 1}
     catch
         throw:unprintable ->
-            {R, Len} = list_body([H|T], Max-2),
+            {R, Len} = list_body([H|T], Max-2, Options, false),
             {[$[, R, $]], Len + 2}
     end;
-alist_start([H|T], Max) when H =:= 9; H =:= 10; H =:= 13 ->
-    try alist([H|T], Max -1) of
+alist_start([H|T], Max, Options) when H =:= 9; H =:= 10; H =:= 13 ->
+    try alist([H|T], Max -1, Options) of
         {L, Len} ->
             {[$"|L], Len + 1}
     catch
         throw:unprintable ->
-            {R, Len} = list_body([H|T], Max-2),
+            {R, Len} = list_body([H|T], Max-2, Options, false),
             {[$[, R, $]], Len + 2}
     end;
-alist_start(L, Max) ->
-    {R, Len} = list_body(L, Max-2),
+alist_start(L, Max, Options) ->
+    {R, Len} = list_body(L, Max-2, Options, false),
     {[$[, R, $]], Len + 2}.
 
-alist([], _) -> {"\"", 1};
-alist(_, Max) when Max < 5 -> {"...\"", 4};
-alist([H|T], Max) when is_integer(H), H >= 16#20, H =< 16#7e ->     % definitely printable
-    {L, Len} = alist(T, Max-1),
+alist([], _Max, #print_options{force_strings=true}) -> {"", 0};
+alist([], _Max, _Options) -> {"\"", 1};
+alist(_, Max, #print_options{force_strings=true}) when Max < 4 -> {"...", 3};
+alist(_, Max, #print_options{force_strings=false}) when Max < 5 -> {"...\"", 4};
+alist([H|T], Max, Options) when is_integer(H), H >= 16#20, H =< 16#7e ->     % definitely printable
+    {L, Len} = alist(T, Max-1, Options),
     {[H|L], Len + 1};
-alist([H|T], Max) when H =:= 9; H =:= 10; H =:= 13 ->
-    {L, Len} = alist(T, Max-1),
+alist([H|T], Max, Options) when H =:= 9; H =:= 10; H =:= 13 ->
+    {L, Len} = alist(T, Max-1, Options),
+    case Options#print_options.force_strings of
+        true ->
+            {[H|L], Len + 1};
+        _ ->
+            {[escape(H)|L], Len + 1}
+    end;
+alist([H|T], Max, #print_options{force_strings=true} = Options) when is_integer(H) ->
+    {L, Len} = alist(T, Max-1, Options),
     {[H|L], Len + 1};
-alist(_L, _Max) ->
+alist(_, _, #print_options{force_strings=true}) ->
+    error(badarg);
+alist(_L, _Max, _Options) ->
     throw(unprintable).
 
 %% is the first character in the atom alphabetic & lowercase?
@@ -359,29 +302,23 @@ atom_needs_quoting([H|T]) when (H >= $a andalso H =< $z);
 atom_needs_quoting(_) ->
     true.
 
-unquote_string([$<, $<, $"|T] = Str) ->
-    case string:substr(T, length(T) - 2) of
-        "\">>" ->
-            string:substr(T, 1, length(T) - 3);
-        _ ->
-            Str
-    end;
-unquote_string([$"|_] = Str) ->
-    case lists:last(Str) == $" of
-        true ->
-            string:strip(Str, both, $");
-        _ ->
-            Str
-    end;
-unquote_string([$'|_] = Str) ->
-    case lists:last(Str) == $' of
-        true ->
-            string:strip(Str, both, $');
-        _ ->
-            Str
-    end;
-unquote_string(S) ->
-    S.
+prepare_options([], Options) ->
+    Options;
+prepare_options([{depth, Depth}|T], Options) when is_integer(Depth) ->
+    prepare_options(T, Options#print_options{depth=Depth});
+prepare_options([{lists_as_strings, Bool}|T], Options) when is_boolean(Bool) ->
+    prepare_options(T, Options#print_options{lists_as_strings = Bool});
+prepare_options([{force_strings, Bool}|T], Options) when is_boolean(Bool) ->
+    prepare_options(T, Options#print_options{force_strings = Bool}).
+
+dec_depth(#print_options{depth=Depth} = Options) when Depth > 0 ->
+    Options#print_options{depth=Depth-1};
+dec_depth(Options) ->
+    Options.
+
+escape(9) -> "\\t";
+escape(10) -> "\\n";
+escape(13) -> "\\r".
 
 -ifdef(TEST).
 %%--------------------
@@ -444,20 +381,22 @@ perf1() ->
 format_test() ->
     %% simple format strings
     ?assertEqual("foobar", lists:flatten(format("~s", [["foo", $b, $a, $r]], 50))),
-    ?assertEqual("\"foobar\"", lists:flatten(format("~p", [["foo", $b, $a, $r]], 50))),
-    ?assertEqual("\"foobar\"", lists:flatten(format("~P", [["foo", $b, $a, $r], 10], 50))),
-    ?assertEqual("[\"foo\",98,97,114]", lists:flatten(format("~w", [["foo", $b, $a, $r], 10], 50))),
+    ?assertEqual("[\"foo\",98,97,114]", lists:flatten(format("~p", [["foo", $b, $a, $r]], 50))),
+    ?assertEqual("[\"foo\",98,97,114]", lists:flatten(format("~P", [["foo", $b, $a, $r], 10], 50))),
+    ?assertEqual("[[102,111,111],98,97,114]", lists:flatten(format("~w", [["foo", $b, $a, $r]], 50))),
     
     %% complex ones
-    ?assertEqual("foobar", lists:flatten(format("~10s", [["foo", $b, $a, $r]], 50))),
-    ?assertEqual("\"foobar\"", lists:flatten(format("~10p", [["foo", $b, $a, $r]], 50))),
-    ?assertEqual("\"foobar\"", lists:flatten(format("~10P", [["foo", $b, $a, $r], 10], 50))),
-    ?assertEqual("[\"foo\",98,97,114]", lists:flatten(format("~10W", [["foo", $b, $a, $r], 10], 50))),
+    ?assertEqual("    foobar", lists:flatten(format("~10s", [["foo", $b, $a, $r]], 50))),
+    ?assertEqual("     [\"foo\",98,97,114]", lists:flatten(format("~22p", [["foo", $b, $a, $r]], 50))),
+    ?assertEqual("     [\"foo\",98,97,114]", lists:flatten(format("~22P", [["foo", $b, $a, $r], 10], 50))),
+    ?assertEqual("**********", lists:flatten(format("~10W", [["foo", $b, $a, $r], 10], 50))),
+    ?assertEqual("[[102,111,111],98,97,114]", lists:flatten(format("~25W", [["foo", $b, $a, $r], 10], 50))),
     ok.
 
 atom_quoting_test() ->
     ?assertEqual("hello", lists:flatten(format("~p", [hello], 50))),
     ?assertEqual("'hello world'", lists:flatten(format("~p", ['hello world'], 50))),
+    ?assertEqual("'Hello world'", lists:flatten(format("~p", ['Hello world'], 50))),
     ?assertEqual("hello_world", lists:flatten(format("~p", ['hello_world'], 50))),
     ?assertEqual("'node@127.0.0.1'", lists:flatten(format("~p", ['node@127.0.0.1'], 50))),
     ?assertEqual("node@nohost", lists:flatten(format("~p", [node@nohost], 50))),
@@ -473,7 +412,7 @@ sane_float_printing_test() ->
 
 float_inside_list_test() ->
     ?assertEqual("[97,38.233913133184835,99]", lists:flatten(format("~p", [[$a, 38.233913133184835, $c]], 50))),
-    ?assertEqual("[97,38.233913133184835,99]", lists:flatten(format("~s", [[$a, 38.233913133184835, $c]], 50))),
+    ?assertError(badarg, lists:flatten(format("~s", [[$a, 38.233913133184835, $c]], 50))),
     ok.
 
 quote_strip_test() ->
@@ -486,23 +425,77 @@ quote_strip_test() ->
     ok.
 
 binary_printing_test() ->
+    ?assertEqual("<<>>", lists:flatten(format("~p", [<<>>], 50))),
+    ?assertEqual("<<..>>", lists:flatten(format("~p", [<<"hi">>], 0))),
     ?assertEqual("<<\"hello\">>", lists:flatten(format("~p", [<<$h, $e, $l, $l, $o>>], 50))),
     ?assertEqual("<<\"hello\">>", lists:flatten(format("~p", [<<"hello">>], 50))),
+    ?assertEqual("<<104,101,108,108,111>>", lists:flatten(format("~w", [<<"hello">>], 50))),
     ?assertEqual("<<1,2,3,4>>", lists:flatten(format("~p", [<<1, 2, 3, 4>>], 50))),
-    ?assertEqual("<<1,2,3,4>>", lists:flatten(format("~s", [<<1, 2, 3, 4>>], 50))),
+    ?assertEqual([1,2,3,4], lists:flatten(format("~s", [<<1, 2, 3, 4>>], 50))),
     ?assertEqual("hello", lists:flatten(format("~s", [<<"hello">>], 50))),
-    ?assertEqual("hello", lists:flatten(format("~10s", [<<"hello">>], 50))),
+    ?assertEqual("hello\nworld", lists:flatten(format("~s", [<<"hello\nworld">>], 50))),
+    ?assertEqual("<<\"hello\\nworld\">>", lists:flatten(format("~p", [<<"hello\nworld">>], 50))),
+    ?assertEqual("     hello", lists:flatten(format("~10s", [<<"hello">>], 50))),
     ok.
 
 list_printing_test() ->
+    ?assertEqual("[]", lists:flatten(format("~p", [[]], 50))),
+    ?assertEqual("[]", lists:flatten(format("~w", [[]], 50))),
+    ?assertEqual("", lists:flatten(format("~s", [[]], 50))),
+    ?assertEqual("...", lists:flatten(format("~s", [[]], -1))),
+    ?assertEqual("[[]]", lists:flatten(format("~p", [[[]]], 50))),
     ?assertEqual("[13,11,10,8,5,4]", lists:flatten(format("~p", [[13,11,10,8,5,4]], 50))),
+    ?assertEqual("\"\\rabc\"", lists:flatten(format("~p", [[13,$a, $b, $c]], 50))),
     ?assertEqual("[1,2,3|4]", lists:flatten(format("~p", [[1, 2, 3|4]], 50))),
+    ?assertEqual("[...]", lists:flatten(format("~p", [[1, 2, 3,4]], 4))),
+    ?assertEqual("[1,...]", lists:flatten(format("~p", [[1, 2, 3,4]], 6))),
     ?assertEqual("[1|4]", lists:flatten(format("~p", [[1|4]], 50))),
+    ?assertEqual("[1]", lists:flatten(format("~p", [[1]], 50))),
+    ?assertError(badarg, lists:flatten(format("~s", [[1|4]], 50))),
     ?assertEqual("\"hello...\"", lists:flatten(format("~p", ["hello world"], 10))),
-    ?assertEqual("hello...", lists:flatten(format("~s", ["hello world"], 10))),
+    ?assertEqual("hello w...", lists:flatten(format("~s", ["hello world"], 10))),
     ?assertEqual("hello world\r\n", lists:flatten(format("~s", ["hello world\r\n"], 50))),
     ?assertEqual("\rhello world\r\n", lists:flatten(format("~s", ["\rhello world\r\n"], 50))),
+    ?assertEqual("\"\\rhello world\\r\\n\"", lists:flatten(format("~p", ["\rhello world\r\n"], 50))),
+    ?assertEqual("[13,104,101,108,108,111,32,119,111,114,108,100,13,10]", lists:flatten(format("~w", ["\rhello world\r\n"], 60))),
     ?assertEqual("...", lists:flatten(format("~s", ["\rhello world\r\n"], 3))),
-    ?assertEqual("[]", lists:flatten(format("~s", [[]], 50))),
     ok.
+
+tuple_printing_test() ->
+    ?assertEqual("{}", lists:flatten(format("~p", [{}], 50))),
+    ?assertEqual("{}", lists:flatten(format("~w", [{}], 50))),
+    ?assertError(badarg, lists:flatten(format("~s", [{}], 50))),
+    ?assertEqual("{...}", lists:flatten(format("~p", [{foo}], 3))),
+    ?assertEqual("{foo,...}", lists:flatten(format("~p", [{foo,bar}], 6))),
+    ?assertEqual("{foo,bar}", lists:flatten(format("~p", [{foo,bar}], 9))),
+    ok.
+
+unicode_test() ->
+    ?assertEqual([231,167,129], lists:flatten(format("~s", [<<231,167,129>>], 50))),
+    ?assertEqual([31169], lists:flatten(format("~ts", [<<231,167,129>>], 50))),
+    ok.
+
+depth_limit_test() ->
+    ?assertEqual("{...}", lists:flatten(format("~P", [{a, [b, [c, [d]]]}, 1], 50))),
+    ?assertEqual("{a,...}", lists:flatten(format("~P", [{a, [b, [c, [d]]]}, 2], 50))),
+    ?assertEqual("{a,[...]}", lists:flatten(format("~P", [{a, [b, [c, [d]]]}, 3], 50))),
+    ?assertEqual("{a,[b|...]}", lists:flatten(format("~P", [{a, [b, [c, [d]]]}, 4], 50))),
+    ?assertEqual("{a,[b,[...]]}", lists:flatten(format("~P", [{a, [b, [c, [d]]]}, 5], 50))),
+    ?assertEqual("{a,[b,[c|...]]}", lists:flatten(format("~P", [{a, [b, [c, [d]]]}, 6], 50))),
+    ?assertEqual("{a,[b,[c,[...]]]}", lists:flatten(format("~P", [{a, [b, [c, [d]]]}, 7], 50))),
+    ?assertEqual("{a,[b,[c,[d]]]}", lists:flatten(format("~P", [{a, [b, [c, [d]]]}, 8], 50))),
+    ?assertEqual("{a,[b,[c,[d]]]}", lists:flatten(format("~P", [{a, [b, [c, [d]]]}, 9], 50))),
+
+    ?assertEqual("{a,{...}}", lists:flatten(format("~P", [{a, {b, {c, {d}}}}, 3], 50))),
+    ?assertEqual("{a,{b,...}}", lists:flatten(format("~P", [{a, {b, {c, {d}}}}, 4], 50))),
+    ?assertEqual("{a,{b,{...}}}", lists:flatten(format("~P", [{a, {b, {c, {d}}}}, 5], 50))),
+    ?assertEqual("{a,{b,{c,...}}}", lists:flatten(format("~P", [{a, {b, {c, {d}}}}, 6], 50))),
+    ?assertEqual("{a,{b,{c,{...}}}}", lists:flatten(format("~P", [{a, {b, {c, {d}}}}, 7], 50))),
+    ?assertEqual("{a,{b,{c,{d}}}}", lists:flatten(format("~P", [{a, {b, {c, {d}}}}, 8], 50))),
+
+    ?assertEqual("{\"a\",[...]}", lists:flatten(format("~P", [{"a", ["b", ["c", ["d"]]]}, 3], 50))),
+    ?assertEqual("{\"a\",[\"b\",[[...]|...]]}", lists:flatten(format("~P", [{"a", ["b", ["c", ["d"]]]}, 6], 50))),
+    ?assertEqual("{\"a\",[\"b\",[\"c\",[\"d\"]]]}", lists:flatten(format("~P", [{"a", ["b", ["c", ["d"]]]}, 9], 50))),
+    ok.
+
 -endif.

test/trunc_io_eqc.erl

@@ -23,7 +23,7 @@
 
 -ifdef(TEST).
 -ifdef(EQC).
--export([test/0, test/1, check/0]).
+-export([test/0, test/1, check/0, prop_format/0]).
 
 -include_lib("eqc/include/eqc.hrl").
 -include_lib("eunit/include/eunit.hrl").
@@ -76,13 +76,13 @@ gen_fmt_args() ->
                 {"~.36B", nat()},
                 {"~62P", gen_any(5), 4},
                 {"~c", gen_char()},
-                {"~tc", gen_char()}
-                %{"~f", real()}, %% floats like to make the fudge limit fail, so don't enable them
-                %{"~10.f", real()},
-                %{"~g", real()},
-                %{"~10.g", real()},
-                %{"~e", real()},
-                %{"~10.e", real()}
+                {"~tc", gen_char()},
+                {"~f", real()},
+                {"~10.f", real()},
+                {"~g", real()},
+                {"~10.g", real()},
+                {"~e", real()},
+                {"~10.e", real()}
                ])).
              
 
@@ -139,7 +139,8 @@ gen_char() ->
 prop_format() ->
     ?FORALL({FmtArgs, MaxLen}, {gen_fmt_args(), gen_max_len()},
             begin
-                FudgeLen = 50, %% trunc_io does not correctly calc safe size of pid/port/numbers/funs
+                %% trunc_io does not correctly calc safe size of pid/port/numbers/funs
+                FudgeLen = calculate_fudge(FmtArgs, 50),
                 {FmtStr, Args} = build_fmt_args(FmtArgs),
                 try
                     Str = lists:flatten(lager_trunc_io:format(FmtStr, Args, MaxLen)),
@@ -182,5 +183,18 @@ build_fmt_args(FmtArgs) ->
         end,
     lists:foldl(F, {"", []}, FmtArgs).
 
+calculate_fudge([], Acc) ->
+    Acc;
+calculate_fudge([{"~62P", _Arg, _Depth}|T], Acc) ->
+    calculate_fudge(T, Acc+62);
+calculate_fudge([{Fmt, Arg}|T], Acc) when
+        Fmt == "~f"; Fmt == "~10.f";
+        Fmt == "~g"; Fmt == "~10.g";
+        Fmt == "~e"; Fmt == "~10.e";
+        Fmt == "~x"; Fmt == "~X" ->
+    calculate_fudge(T, Acc + length(lists:flatten(io_lib:format(Fmt, [Arg]))));
+calculate_fudge([_|T], Acc) ->
+    calculate_fudge(T, Acc).
+
 -endif. % (EQC).
 -endif. % (TEST).