Skip to content

Commit 0774e40

Browse files
committed
Bump erlware_commons to 1.8.0
This fixes an OTP-28 compat issue with some OSes
1 parent 6a5805d commit 0774e40

15 files changed

+82
-988
lines changed

apps/rebar/rebar.config

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,7 @@
33

44
%% Upgrade by calling 'rebar3 experimental vendor' and making sure
55
%% any manual patches (Eg. erlware_commons or relx) are kept.
6-
{deps, [{erlware_commons, "1.7.0"},
6+
{deps, [{erlware_commons, "1.8.0"},
77
{ssl_verify_fun, "1.1.6"},
88
{certifi, "2.13.0"},
99
{providers, "1.9.0"},

vendor/erlware_commons/README.md

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,8 @@ Erlware Commons
44
Current Status
55
--------------
66

7-
![Tests](https://github.com/erlware/erlware_commons/workflows/EUnit/badge.svg)
7+
[![Hex.pm](https://img.shields.io/hexpm/v/erlware_commons)](https://hex.pm/packages/erlware_commons)
8+
[![Tests](https://github.com/erlware/erlware_commons/workflows/EUnit/badge.svg)](https://github.com/erlware/erlware_commons/actions)
89

910
Introduction
1011
------------

vendor/erlware_commons/hex_metadata.config

Lines changed: 7 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -5,11 +5,12 @@
55
[<<"README.md">>,<<"include">>,<<"include/ec_cmd_log.hrl">>,<<"priv">>,
66
<<"priv/ec_semver_parser.peg">>,<<"rebar.config">>,
77
<<"rebar.config.script">>,<<"rebar.lock">>,<<"src">>,
8-
<<"src/ec_assoc_list.erl">>,<<"src/ec_cmd_log.erl">>,<<"src/ec_cnv.erl">>,
9-
<<"src/ec_compile.erl">>,<<"src/ec_date.erl">>,<<"src/ec_dict.erl">>,
10-
<<"src/ec_dictionary.erl">>,<<"src/ec_file.erl">>,<<"src/ec_gb_trees.erl">>,
11-
<<"src/ec_git_vsn.erl">>,<<"src/ec_lists.erl">>,<<"src/ec_orddict.erl">>,
12-
<<"src/ec_plists.erl">>,<<"src/ec_rbdict.erl">>,<<"src/ec_semver.erl">>,
8+
<<"src/ec_assoc_list.erl">>,<<"src/ec_cmd_log.erl">>,
9+
<<"src/ec_cmd_log.hrl">>,<<"src/ec_cnv.erl">>,<<"src/ec_compile.erl">>,
10+
<<"src/ec_date.erl">>,<<"src/ec_dict.erl">>,<<"src/ec_dictionary.erl">>,
11+
<<"src/ec_file.erl">>,<<"src/ec_gb_trees.erl">>,<<"src/ec_git_vsn.erl">>,
12+
<<"src/ec_lists.erl">>,<<"src/ec_orddict.erl">>,<<"src/ec_plists.erl">>,
13+
<<"src/ec_rbdict.erl">>,<<"src/ec_semver.erl">>,
1314
<<"src/ec_semver_parser.erl">>,<<"src/ec_talk.erl">>,<<"src/ec_vsn.erl">>,
1415
<<"src/erlware_commons.app.src">>]}.
1516
{<<"licenses">>,[<<"Apache">>,<<"MIT">>]}.
@@ -21,4 +22,4 @@
2122
[{<<"app">>,<<"cf">>},
2223
{<<"optional">>,false},
2324
{<<"requirement">>,<<"~>0.3">>}]}]}.
24-
{<<"version">>,<<"1.7.0">>}.
25+
{<<"version">>,<<"1.8.0">>}.
Lines changed: 5 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -1,18 +1,7 @@
1-
IsRebar3 = true,
1+
NoDialWarns = {dialyzer, [{warnings, [no_unknown]}]},
2+
OTPRelease = erlang:list_to_integer(erlang:system_info(otp_release)),
23

3-
Rebar2Deps = [
4-
{cf, ".*", {git, "https://github.com/project-fifo/cf", {tag, "0.2.2"}}}
5-
],
6-
7-
NoDialWarns = {dialyzer, [{warnings, [no_unknown]}]},
8-
OTPRelease = erlang:list_to_integer(erlang:system_info(otp_release)),
9-
WarnsRemoved = case OTPRelease<26 of
10-
true -> fun(Config) -> Config end;
11-
false -> fun(Config) -> lists:keystore(dialyzer, 1, Config, NoDialWarns) end
12-
end,
13-
14-
case IsRebar3 of
15-
true -> WarnsRemoved(CONFIG);
16-
false ->
17-
lists:keyreplace(deps, 1, WarnsRemoved(CONFIG), {deps, Rebar2Deps})
4+
case OTPRelease<26 of
5+
true -> CONFIG;
6+
false -> lists:keystore(dialyzer, 1, CONFIG, NoDialWarns)
187
end.

vendor/erlware_commons/src/ec_cmd_log.erl

Lines changed: 4 additions & 50 deletions
Original file line numberDiff line numberDiff line change
@@ -40,22 +40,17 @@
4040
warn/3,
4141
log_level/1,
4242
atom_log_level/1,
43+
colorize/4,
4344
format/1]).
4445

45-
-include("ec_cmd_log.hrl").
46-
47-
-define(RED, $r).
48-
-define(GREEN, $g).
49-
-define(YELLOW, $y).
50-
-define(BLUE, $b).
51-
-define(MAGENTA, $m).
52-
-define(CYAN, $c).
46+
-include("include/ec_cmd_log.hrl").
47+
-include("src/ec_cmd_log.hrl").
5348

5449
-define(PREFIX, "===> ").
5550

5651
-record(state_t, {log_level=0 :: int_log_level(),
5752
caller=api :: caller(),
58-
intensity=low :: none | low | high}).
53+
intensity=low :: intensity()}).
5954

6055
%%============================================================================
6156
%% types
@@ -260,44 +255,3 @@ colorize(#state_t{caller=command_line, intensity = low},
260255
lists:flatten(cf:format("~!" ++ [Color] ++"~ts~!!~ts", [?PREFIX, Msg]));
261256
colorize(_LogState, _Color, _Bold, Msg) ->
262257
Msg.
263-
264-
%%%===================================================================
265-
%%% Test Functions
266-
%%%===================================================================
267-
268-
-ifdef(TEST).
269-
-include_lib("eunit/include/eunit.hrl").
270-
271-
should_test() ->
272-
ErrorLogState = new(error),
273-
?assertMatch(true, should(ErrorLogState, ?EC_ERROR)),
274-
?assertMatch(true, not should(ErrorLogState, ?EC_INFO)),
275-
?assertMatch(true, not should(ErrorLogState, ?EC_DEBUG)),
276-
?assertEqual(?EC_ERROR, log_level(ErrorLogState)),
277-
?assertEqual(error, atom_log_level(ErrorLogState)),
278-
279-
InfoLogState = new(info),
280-
?assertMatch(true, should(InfoLogState, ?EC_ERROR)),
281-
?assertMatch(true, should(InfoLogState, ?EC_INFO)),
282-
?assertMatch(true, not should(InfoLogState, ?EC_DEBUG)),
283-
?assertEqual(?EC_INFO, log_level(InfoLogState)),
284-
?assertEqual(info, atom_log_level(InfoLogState)),
285-
286-
DebugLogState = new(debug),
287-
?assertMatch(true, should(DebugLogState, ?EC_ERROR)),
288-
?assertMatch(true, should(DebugLogState, ?EC_INFO)),
289-
?assertMatch(true, should(DebugLogState, ?EC_DEBUG)),
290-
?assertEqual(?EC_DEBUG, log_level(DebugLogState)),
291-
?assertEqual(debug, atom_log_level(DebugLogState)).
292-
293-
294-
no_color_test() ->
295-
LogState = new(debug, command_line, none),
296-
?assertEqual("test",
297-
colorize(LogState, ?RED, true, "test")).
298-
299-
color_test() ->
300-
LogState = new(debug, command_line, high),
301-
?assertEqual("\e[1;31m===> test\e[0m",
302-
colorize(LogState, ?RED, true, "test")).
303-
-endif.
Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,7 @@
1+
%%% @copyright 2024 Erlware, LLC.
2+
-define(RED, $r).
3+
-define(GREEN, $g).
4+
-define(YELLOW, $y).
5+
-define(BLUE, $b).
6+
-define(MAGENTA, $m).
7+
-define(CYAN, $c).

vendor/erlware_commons/src/ec_cnv.erl

Lines changed: 0 additions & 33 deletions
Original file line numberDiff line numberDiff line change
@@ -212,36 +212,3 @@ to_atom(X)
212212
erlang:list_to_existing_atom(X);
213213
to_atom(X) ->
214214
to_atom(to_list(X)).
215-
216-
%%%===================================================================
217-
%%% Tests
218-
%%%===================================================================
219-
220-
-ifdef(TEST).
221-
-include_lib("eunit/include/eunit.hrl").
222-
223-
to_integer_test() ->
224-
?assertError(badarg, to_integer(1.5, strict)).
225-
226-
to_float_test() ->
227-
?assertError(badarg, to_float(10, strict)).
228-
229-
to_atom_test() ->
230-
?assertMatch(true, to_atom("true")),
231-
?assertMatch(true, to_atom(<<"true">>)),
232-
?assertMatch(false, to_atom(<<"false">>)),
233-
?assertMatch(false, to_atom(false)),
234-
?assertError(badarg, to_atom("hello_foo_bar_baz")),
235-
236-
S = erlang:list_to_atom("1"),
237-
?assertMatch(S, to_atom(1)).
238-
239-
to_boolean_test()->
240-
?assertMatch(true, to_boolean(<<"true">>)),
241-
?assertMatch(true, to_boolean("true")),
242-
?assertMatch(true, to_boolean(true)),
243-
?assertMatch(false, to_boolean(<<"false">>)),
244-
?assertMatch(false, to_boolean("false")),
245-
?assertMatch(false, to_boolean(false)).
246-
247-
-endif.

vendor/erlware_commons/src/ec_date.erl

Lines changed: 39 additions & 39 deletions
Original file line numberDiff line numberDiff line change
@@ -44,7 +44,7 @@
4444
-define( is_month(X), ( (is_integer(X) andalso X =< 12) orelse ?is_hinted_month(X) ) ).
4545
-define( is_tz_offset(H1,H2,M1,M2), (?is_num(H1) andalso ?is_num(H2) andalso ?is_num(M1) andalso ?is_num(M2)) ).
4646

47-
-define(GREGORIAN_SECONDS_1970, 62167219200).
47+
-define(GREGORIAN_SECONDS_1970, 62_167_219_200).
4848
-define(ISO_8601_DATETIME_FORMAT, "Y-m-dTH:i:sZ").
4949
-define(ISO_8601_DATETIME_WITH_MS_FORMAT, "Y-m-dTH:i:s.fZ").
5050

@@ -54,7 +54,7 @@
5454
-type hour() :: 0..23.
5555
-type minute() :: 0..59.
5656
-type second() :: 0..59.
57-
-type microsecond() :: 0..999999.
57+
-type microsecond() :: 0..999_999.
5858

5959
-type daynum() :: 1..7.
6060
-type date() :: {year(),month(),day()}.
@@ -138,11 +138,11 @@ nparse(Date) ->
138138
{DateS, {H, M, S, Ms} } ->
139139
GSeconds = calendar:datetime_to_gregorian_seconds({DateS, {H, M, S} }),
140140
ESeconds = GSeconds - ?GREGORIAN_SECONDS_1970,
141-
{ESeconds div 1000000, ESeconds rem 1000000, Ms};
141+
{ESeconds div 1_000_000, ESeconds rem 1_000_000, Ms};
142142
DateTime ->
143143
GSeconds = calendar:datetime_to_gregorian_seconds(DateTime),
144144
ESeconds = GSeconds - ?GREGORIAN_SECONDS_1970,
145-
{ESeconds div 1000000, ESeconds rem 1000000, 0}
145+
{ESeconds div 1_000_000, ESeconds rem 1_000_000, 0}
146146
end.
147147

148148
%%
@@ -151,7 +151,7 @@ nparse(Date) ->
151151

152152
parse([Year, X, Month, X, Day, Hour, $:, Min, $:, Sec, $., Micros, $Z ], _Now, _Opts)
153153
when ?is_world_sep(X)
154-
andalso (Micros >= 0 andalso Micros < 1000000)
154+
andalso (Micros >= 0 andalso Micros < 1_000_000)
155155
andalso Year > 31 ->
156156
{{Year, Month, Day}, {hour(Hour, []), Min, Sec}, {Micros}};
157157

@@ -162,7 +162,7 @@ parse([Year, X, Month, X, Day, Hour, $:, Min, $:, Sec, $Z ], _Now, _Opts)
162162

163163
parse([Year, X, Month, X, Day, Hour, $:, Min, $:, Sec, $., Micros, $+, Off | _Rest ], _Now, _Opts)
164164
when (?is_us_sep(X) orelse ?is_world_sep(X))
165-
andalso (Micros >= 0 andalso Micros < 1000000)
165+
andalso (Micros >= 0 andalso Micros < 1_000_000)
166166
andalso Year > 31 ->
167167
{{Year, Month, Day}, {hour(Hour, []) - Off, Min, Sec}, {Micros}};
168168

@@ -173,7 +173,7 @@ parse([Year, X, Month, X, Day, Hour, $:, Min, $:, Sec, $+, Off | _Rest ], _Now,
173173

174174
parse([Year, X, Month, X, Day, Hour, $:, Min, $:, Sec, $., Micros, $-, Off | _Rest ], _Now, _Opts)
175175
when (?is_us_sep(X) orelse ?is_world_sep(X))
176-
andalso (Micros >= 0 andalso Micros < 1000000)
176+
andalso (Micros >= 0 andalso Micros < 1_000_000)
177177
andalso Year > 31 ->
178178
{{Year, Month, Day}, {hour(Hour, []) + Off, Min, Sec}, {Micros}};
179179

@@ -316,11 +316,11 @@ tokenise([$., N1, N2, N3, N4 | Rest], Acc)
316316
when ?is_num(N1), ?is_num(N2), ?is_num(N3), ?is_num(N4) ->
317317
tokenise(Rest, [ ltoi([N1, N2, N3, N4]) * 100, $. | Acc]);
318318
tokenise([$., N1, N2, N3 | Rest], Acc) when ?is_num(N1), ?is_num(N2), ?is_num(N3) ->
319-
tokenise(Rest, [ ltoi([N1, N2, N3]) * 1000, $. | Acc]);
319+
tokenise(Rest, [ ltoi([N1, N2, N3]) * 1_000, $. | Acc]);
320320
tokenise([$., N1, N2 | Rest], Acc) when ?is_num(N1), ?is_num(N2) ->
321-
tokenise(Rest, [ ltoi([N1, N2]) * 10000, $. | Acc]);
321+
tokenise(Rest, [ ltoi([N1, N2]) * 10_000, $. | Acc]);
322322
tokenise([$., N1 | Rest], Acc) when ?is_num(N1) ->
323-
tokenise(Rest, [ ltoi([N1]) * 100000, $. | Acc]);
323+
tokenise(Rest, [ ltoi([N1]) * 100_000, $. | Acc]);
324324

325325
tokenise([N1, N2, N3, N4, N5, N6 | Rest], Acc)
326326
when ?is_num(N1), ?is_num(N2), ?is_num(N3), ?is_num(N4), ?is_num(N5), ?is_num(N6) ->
@@ -718,7 +718,7 @@ ltoi(X) ->
718718

719719

720720
-define(DATE, {{2001,3,10},{17,16,17}}).
721-
-define(DATEMS, {{2001,3,10},{17,16,17,123456}}).
721+
-define(DATEMS, {{2001,3,10},{17,16,17,123_456}}).
722722
-define(DATE_NOON, {{2001,3,10},{12,0,0}}).
723723
-define(DATE_MIDNIGHT, {{2001,3,10},{0,0,0}}).
724724
-define(ISO, "o \\WW").
@@ -955,7 +955,7 @@ ms_test_() ->
955955
Now=os:timestamp(),
956956
[
957957
?_assertEqual({{2012,12,12}, {12,12,12,1234}}, parse("2012-12-12T12:12:12.001234")),
958-
?_assertEqual({{2012,12,12}, {12,12,12,123000}}, parse("2012-12-12T12:12:12.123")),
958+
?_assertEqual({{2012,12,12}, {12,12,12,123_000}}, parse("2012-12-12T12:12:12.123")),
959959
?_assertEqual(format("H:m:s.f \\m \\i\\s \\m\\o\\n\\t\\h",?DATEMS),
960960
"17:03:17.123456 m is month"),
961961
?_assertEqual(format("Y-m-d\\TH:i:s.f",?DATEMS),
@@ -994,21 +994,21 @@ format_iso8601_test_() ->
994994
?_assertEqual("2001-03-10T17:16:17.000000Z",
995995
format_iso8601({{2001,3,10},{17,16,17,0}})),
996996
?_assertEqual("2001-03-10T17:16:17.100000Z",
997-
format_iso8601({{2001,3,10},{17,16,17,100000}})),
997+
format_iso8601({{2001,3,10},{17,16,17,100_000}})),
998998
?_assertEqual("2001-03-10T17:16:17.120000Z",
999-
format_iso8601({{2001,3,10},{17,16,17,120000}})),
999+
format_iso8601({{2001,3,10},{17,16,17,120_000}})),
10001000
?_assertEqual("2001-03-10T17:16:17.123000Z",
1001-
format_iso8601({{2001,3,10},{17,16,17,123000}})),
1001+
format_iso8601({{2001,3,10},{17,16,17,123_000}})),
10021002
?_assertEqual("2001-03-10T17:16:17.123400Z",
1003-
format_iso8601({{2001,3,10},{17,16,17,123400}})),
1003+
format_iso8601({{2001,3,10},{17,16,17,123_400}})),
10041004
?_assertEqual("2001-03-10T17:16:17.123450Z",
1005-
format_iso8601({{2001,3,10},{17,16,17,123450}})),
1005+
format_iso8601({{2001,3,10},{17,16,17,123_450}})),
10061006
?_assertEqual("2001-03-10T17:16:17.123456Z",
1007-
format_iso8601({{2001,3,10},{17,16,17,123456}})),
1007+
format_iso8601({{2001,3,10},{17,16,17,123_456}})),
10081008
?_assertEqual("2001-03-10T17:16:17.023456Z",
1009-
format_iso8601({{2001,3,10},{17,16,17,23456}})),
1009+
format_iso8601({{2001,3,10},{17,16,17,23_456}})),
10101010
?_assertEqual("2001-03-10T17:16:17.003456Z",
1011-
format_iso8601({{2001,3,10},{17,16,17,3456}})),
1011+
format_iso8601({{2001,3,10},{17,16,17,3_456}})),
10121012
?_assertEqual("2001-03-10T17:16:17.000456Z",
10131013
format_iso8601({{2001,3,10},{17,16,17,456}})),
10141014
?_assertEqual("2001-03-10T17:16:17.000056Z",
@@ -1020,21 +1020,21 @@ format_iso8601_test_() ->
10201020
?_assertEqual("2001-03-10T07:16:17.000000Z",
10211021
format_iso8601({{2001,3,10},{07,16,17,0}})),
10221022
?_assertEqual("2001-03-10T07:16:17.100000Z",
1023-
format_iso8601({{2001,3,10},{07,16,17,100000}})),
1023+
format_iso8601({{2001,3,10},{07,16,17,100_000}})),
10241024
?_assertEqual("2001-03-10T07:16:17.120000Z",
1025-
format_iso8601({{2001,3,10},{07,16,17,120000}})),
1025+
format_iso8601({{2001,3,10},{07,16,17,120_000}})),
10261026
?_assertEqual("2001-03-10T07:16:17.123000Z",
1027-
format_iso8601({{2001,3,10},{07,16,17,123000}})),
1027+
format_iso8601({{2001,3,10},{07,16,17,123_000}})),
10281028
?_assertEqual("2001-03-10T07:16:17.123400Z",
1029-
format_iso8601({{2001,3,10},{07,16,17,123400}})),
1029+
format_iso8601({{2001,3,10},{07,16,17,123_400}})),
10301030
?_assertEqual("2001-03-10T07:16:17.123450Z",
1031-
format_iso8601({{2001,3,10},{07,16,17,123450}})),
1031+
format_iso8601({{2001,3,10},{07,16,17,123_450}})),
10321032
?_assertEqual("2001-03-10T07:16:17.123456Z",
1033-
format_iso8601({{2001,3,10},{07,16,17,123456}})),
1033+
format_iso8601({{2001,3,10},{07,16,17,123_456}})),
10341034
?_assertEqual("2001-03-10T07:16:17.023456Z",
1035-
format_iso8601({{2001,3,10},{07,16,17,23456}})),
1035+
format_iso8601({{2001,3,10},{07,16,17,23_456}})),
10361036
?_assertEqual("2001-03-10T07:16:17.003456Z",
1037-
format_iso8601({{2001,3,10},{07,16,17,3456}})),
1037+
format_iso8601({{2001,3,10},{07,16,17,3_456}})),
10381038
?_assertEqual("2001-03-10T07:16:17.000456Z",
10391039
format_iso8601({{2001,3,10},{07,16,17,456}})),
10401040
?_assertEqual("2001-03-10T07:16:17.000056Z",
@@ -1051,31 +1051,31 @@ parse_iso8601_test_() ->
10511051
parse("2001-03-10T17:16:17.000Z")),
10521052
?_assertEqual({{2001,3,10},{17,16,17,0}},
10531053
parse("2001-03-10T17:16:17.000000Z")),
1054-
?_assertEqual({{2001,3,10},{17,16,17,100000}},
1054+
?_assertEqual({{2001,3,10},{17,16,17,100_000}},
10551055
parse("2001-03-10T17:16:17.1Z")),
1056-
?_assertEqual({{2001,3,10},{17,16,17,120000}},
1056+
?_assertEqual({{2001,3,10},{17,16,17,120_000}},
10571057
parse("2001-03-10T17:16:17.12Z")),
1058-
?_assertEqual({{2001,3,10},{17,16,17,123000}},
1058+
?_assertEqual({{2001,3,10},{17,16,17,123_000}},
10591059
parse("2001-03-10T17:16:17.123Z")),
1060-
?_assertEqual({{2001,3,10},{17,16,17,123400}},
1060+
?_assertEqual({{2001,3,10},{17,16,17,123_400}},
10611061
parse("2001-03-10T17:16:17.1234Z")),
1062-
?_assertEqual({{2001,3,10},{17,16,17,123450}},
1062+
?_assertEqual({{2001,3,10},{17,16,17,123_450}},
10631063
parse("2001-03-10T17:16:17.12345Z")),
1064-
?_assertEqual({{2001,3,10},{17,16,17,123456}},
1064+
?_assertEqual({{2001,3,10},{17,16,17,123_456}},
10651065
parse("2001-03-10T17:16:17.123456Z")),
10661066

1067-
?_assertEqual({{2001,3,10},{15,16,17,100000}},
1067+
?_assertEqual({{2001,3,10},{15,16,17,100_000}},
10681068
parse("2001-03-10T16:16:17.1+01:00")),
1069-
?_assertEqual({{2001,3,10},{15,16,17,123456}},
1069+
?_assertEqual({{2001,3,10},{15,16,17,123_456}},
10701070
parse("2001-03-10T16:16:17.123456+01:00")),
1071-
?_assertEqual({{2001,3,10},{17,16,17,100000}},
1071+
?_assertEqual({{2001,3,10},{17,16,17,100_000}},
10721072
parse("2001-03-10T16:16:17.1-01:00")),
1073-
?_assertEqual({{2001,3,10},{17,16,17,123456}},
1073+
?_assertEqual({{2001,3,10},{17,16,17,123_456}},
10741074
parse("2001-03-10T16:16:17.123456-01:00")),
10751075

10761076
?_assertEqual({{2001,3,10},{17,16,17,456}},
10771077
parse("2001-03-10T17:16:17.000456Z")),
1078-
?_assertEqual({{2001,3,10},{17,16,17,123000}},
1078+
?_assertEqual({{2001,3,10},{17,16,17,123_000}},
10791079
parse("2001-03-10T17:16:17.123000Z"))
10801080
].
10811081

0 commit comments

Comments
 (0)