File 0637-ssh-replace-size-1-by-XXX_size-1.patch of Package erlang
From 80110cd42c5e14b547057e119ef6cbd31cbbd663 Mon Sep 17 00:00:00 2001
From: Kiko Fernandez-Reyes <kiko@erlang.org>
Date: Tue, 17 Jan 2023 15:06:24 +0100
Subject: [PATCH 1/2] ssh: replace size/1 by XXX_size/1
---
lib/ssh/src/ssh.erl | 6 +++---
lib/ssh/src/ssh_dbg.erl | 12 ++++++------
lib/ssh/src/ssh_options.erl | 7 +++----
lib/ssh/test/ssh_basic_SUITE.erl | 4 ++--
4 files changed, 14 insertions(+), 15 deletions(-)
diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl
index 5fb95fc7d9..ef8765338d 100644
--- a/lib/ssh/src/ssh.erl
+++ b/lib/ssh/src/ssh.erl
@@ -848,7 +848,7 @@ fp_fmt(b64, Bin) ->
%% [C || C<-base64:encode_to_string(Bin), C =/= $=]
%% but I am not sure. Must be checked.
B64Chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/",
- BitsInLast = 8*size(Bin) rem 6,
+ BitsInLast = 8*byte_size(Bin) rem 6,
Padding = (6-BitsInLast) rem 6, % Want BitsInLast = [1:5] to map to padding [5:1] and 0 -> 0
[lists:nth(C+1,B64Chars) || <<C:6>> <= <<Bin/binary,0:Padding>> ].
@@ -943,9 +943,9 @@ is_host(X, Opts) ->
is_host1(L) when is_list(L) -> true; %% "string()"
-is_host1(T) when is_tuple(T), size(T)==4 -> lists:all(fun(I) -> 0=<I andalso I=<255 end,
+is_host1(T) when tuple_size(T)==4 -> lists:all(fun(I) -> 0=<I andalso I=<255 end,
tuple_to_list(T));
-is_host1(T) when is_tuple(T), size(T)==16 -> lists:all(fun(I) -> 0=<I andalso I=<65535 end,
+is_host1(T) when tuple_size(T)==16 -> lists:all(fun(I) -> 0=<I andalso I=<65535 end,
tuple_to_list(T));
is_host1(loopback) -> true.
diff --git a/lib/ssh/src/ssh_dbg.erl b/lib/ssh/src/ssh_dbg.erl
index afeaa5b040..16957f0771 100644
--- a/lib/ssh/src/ssh_dbg.erl
+++ b/lib/ssh/src/ssh_dbg.erl
@@ -156,11 +156,11 @@ go_on() ->
on(IsOn).
%%%----------------------------------------------------------------
-shrink_bin(B) when is_binary(B), size(B)>256 -> {'*** SHRUNK BIN',
- size(B),
+shrink_bin(B) when is_binary(B), byte_size(B)>256 -> {'*** SHRUNK BIN',
+ byte_size(B),
element(1,split_binary(B,64)),
'...',
- element(2,split_binary(B,size(B)-64))
+ element(2,split_binary(B,byte_size(B)-64))
};
shrink_bin(L) when is_list(L) -> lists:map(fun shrink_bin/1, L);
shrink_bin(T) when is_tuple(T) -> list_to_tuple(shrink_bin(tuple_to_list(T)));
@@ -170,12 +170,12 @@ shrink_bin(X) -> X.
%% Replace any occurrence of {Name,...}, with "#Name{}"
reduce_state(T, RecordExample) ->
Name = element(1, RecordExample),
- Arity = size(RecordExample),
+ Arity = tuple_size(RecordExample),
reduce_state(T, Name, Arity).
%% Replace any occurrence of {Name,...}, with "#Name{}"
reduce_state(T, Name, Arity) when element(1,T) == Name,
- size(T) == Arity ->
+ tuple_size(T) == Arity ->
lists:concat(['#',Name,'{}']);
reduce_state(L, Name, Arity) when is_list(L) ->
[reduce_state(E,Name,Arity) || E <- L];
@@ -353,7 +353,7 @@ trace_pid(T) when element(1,T)==trace
%% Pick last element, the Time Stamp, and format it
trace_ts(T) when element(1,T)==trace_ts ->
- ts( element(size(T), T) ).
+ ts( element(tuple_size(T), T) ).
%% Make a tuple of all elements but the 1st, 2nd and last
trace_info(T) ->
diff --git a/lib/ssh/src/ssh_options.erl b/lib/ssh/src/ssh_options.erl
index 2acc46807b..884effa2a7 100644
--- a/lib/ssh/src/ssh_options.erl
+++ b/lib/ssh/src/ssh_options.erl
@@ -176,8 +176,7 @@ handle_options(Role, PropList0) ->
handle_options(Role, OptsList0, Opts0) when is_map(Opts0),
is_list(OptsList0) ->
OptsList1 = proplists:unfold(
- lists:foldr(fun(T,Acc) when is_tuple(T),
- size(T) =/= 2-> [{special_trpt_args,T} | Acc];
+ lists:foldr(fun(T,Acc) when tuple_size(T) =/= 2-> [{special_trpt_args,T} | Acc];
(X,Acc) -> [X|Acc]
end,
[], OptsList0)),
@@ -1079,7 +1078,7 @@ check_modify_algorithms(M) when is_list(M) ->
[error_in_check(Op_KVs, "Bad modify_algorithms")
|| Op_KVs <- M,
not is_tuple(Op_KVs)
- orelse (size(Op_KVs) =/= 2)
+ orelse (tuple_size(Op_KVs) =/= 2)
orelse (not lists:member(element(1,Op_KVs), [append,prepend,rm]))],
{true, [{Op,normalize_mod_algs(KVs,false)} || {Op,KVs} <- M]};
check_modify_algorithms(_) ->
@@ -1191,7 +1190,7 @@ check_input_ok(Algs) ->
[error_in_check(KVs, "Bad preferred_algorithms")
|| KVs <- Algs,
not is_tuple(KVs)
- orelse (size(KVs) =/= 2)].
+ orelse (tuple_size(KVs) =/= 2)].
%%%----------------------------------------------------------------
final_preferred_algorithms(Options0) ->
diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl
index a508d08613..599e7cd15e 100644
--- a/lib/ssh/test/ssh_basic_SUITE.erl
+++ b/lib/ssh/test/ssh_basic_SUITE.erl
@@ -1231,7 +1231,7 @@ packet_size(Config) ->
rec(Server, Conn, Ch, MaxSz) ->
receive
- {ssh_cm,Conn,{data,Ch,_,M}} when size(M) =< MaxSz ->
+ {ssh_cm,Conn,{data,Ch,_,M}} when byte_size(M) =< MaxSz ->
ct:log("~p: ~p",[MaxSz,M]),
rec(Server, Conn, Ch, MaxSz);
{ssh_cm,Conn,{data,Ch,_,_}} = M ->
@@ -1542,7 +1542,7 @@ new_do_shell(IO, N, [new_prompt|More]) ->
new_do_shell(IO, N, Ops=[{Order,Arg}|More]) ->
Pfx = prompt_prefix(),
- PfxSize = size(Pfx),
+ PfxSize = byte_size(Pfx),
receive
_X = <<"\r\n">> ->
ct:log("Skip newline ~p",[_X]),
--
2.35.3