From 31d81e6356aaf58f04495dd902677346818afeb9 Mon Sep 17 00:00:00 2001 From: Richard Carlsson Date: Sat, 14 Dec 2024 20:08:35 +0100 Subject: [PATCH] Replace 'or'/'and' with 'orelse'/'andalso' in test suites --- lib/crypto/test/crypto_SUITE.erl | 6 +- lib/ssh/test/ssh_options_SUITE.erl | 2 +- lib/ssh/test/ssh_pubkey_SUITE.erl | 16 +- lib/stdlib/test/beam_lib_SUITE.erl | 2 +- lib/stdlib/test/binary_module_SUITE.erl | 17 +- lib/stdlib/test/binref.erl | 12 +- lib/stdlib/test/erl_eval_SUITE.erl | 8 +- lib/stdlib/test/erl_lint_SUITE.erl | 6 +- lib/stdlib/test/erl_pp_SUITE.erl | 2 +- lib/stdlib/test/ets_SUITE.erl | 4 +- lib/stdlib/test/id_transform_SUITE.erl | 24 +- lib/stdlib/test/io_SUITE.erl | 2 +- lib/stdlib/test/ms_transform_SUITE.erl | 4 +- lib/stdlib/test/qlc_SUITE.erl | 279 ++++++++++++------------ lib/stdlib/test/run_pcre_tests.erl | 96 ++++---- lib/stdlib/test/select_SUITE.erl | 4 +- lib/stdlib/test/supervisor_SUITE.erl | 4 +- 17 files changed, 244 insertions(+), 244 deletions(-) diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index 89c6343e8575..7f7d03daad06 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -1514,7 +1514,7 @@ cipher_info_prop_aead_attr(Config) when is_list(Config) -> case lists:foldl(fun(C,Ok) -> case crypto:cipher_info(C) of #{prop_aead := true} -> - true and Ok; + true andalso Ok; _ -> false end @@ -1532,7 +1532,7 @@ cipher_info_prop_aead_attr(Config) when is_list(Config) -> case lists:foldl(fun(C,Ok) -> case crypto:cipher_info(C) of #{prop_aead := false} -> - true and Ok; + true andalso Ok; _ -> false end @@ -2075,7 +2075,7 @@ rand_uniform_aux_test(N) -> crypto_rand_uniform(L,H) -> R1 = (L-1) + rand:uniform(H-L), - case (R1 >= L) and (R1 < H) of + case R1 >= L andalso R1 < H of true -> ok; false -> diff --git a/lib/ssh/test/ssh_options_SUITE.erl b/lib/ssh/test/ssh_options_SUITE.erl index 0017570ff6b7..b6358cb73621 100644 --- a/lib/ssh/test/ssh_options_SUITE.erl +++ b/lib/ssh/test/ssh_options_SUITE.erl @@ -1076,7 +1076,7 @@ really_do_hostkey_fingerprint_check(Config, HashAlg) -> end, ct:log("check ~p == ~p (~p) and ~n~p~n in ~p (~p)~n", [PeerName,Host,HostCheck,FP,FPs,FPCheck]), - HostCheck and FPCheck + HostCheck andalso FPCheck end, ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, diff --git a/lib/ssh/test/ssh_pubkey_SUITE.erl b/lib/ssh/test/ssh_pubkey_SUITE.erl index 4dcc91aa9d9d..186d399f44fe 100644 --- a/lib/ssh/test/ssh_pubkey_SUITE.erl +++ b/lib/ssh/test/ssh_pubkey_SUITE.erl @@ -573,11 +573,11 @@ ssh_list_public_key(Config) when is_list(Config) -> ["openssh_rsa_pub", "openssh_dsa_pub", "openssh_ecdsa_pub"]), true = - (chk_decode(Data_openssh, Expect_openssh, openssh_key) and - chk_decode(Data_ssh2, Expect_ssh2, rfc4716_key) and - chk_decode(Data_openssh, Expect_openssh, public_key) and - chk_decode(Data_ssh2, Expect_ssh2, public_key) and - chk_encode(Expect_openssh, openssh_key) and + (chk_decode(Data_openssh, Expect_openssh, openssh_key) andalso + chk_decode(Data_ssh2, Expect_ssh2, rfc4716_key) andalso + chk_decode(Data_openssh, Expect_openssh, public_key) andalso + chk_decode(Data_ssh2, Expect_ssh2, public_key) andalso + chk_encode(Expect_openssh, openssh_key) andalso chk_encode(Expect_ssh2, rfc4716_key) ). @@ -702,7 +702,7 @@ ssh_known_hosts(Config) when is_list(Config) -> Value1 = proplists:get_value(hostnames, Attributes1, undefined), Value2 = proplists:get_value(hostnames, Attributes2, undefined), - true = (Value1 =/= undefined) and (Value2 =/= undefined), + true = Value1 =/= undefined andalso Value2 =/= undefined, Encoded = ssh_file:encode(Decoded, known_hosts), Decoded = ssh_file:decode(Encoded, known_hosts). @@ -717,7 +717,7 @@ ssh1_known_hosts(Config) when is_list(Config) -> Value1 = proplists:get_value(hostnames, Attributes1, undefined), Value2 = proplists:get_value(hostnames, Attributes2, undefined), - true = (Value1 =/= undefined) and (Value2 =/= undefined), + true = Value1 =/= undefined andalso Value2 =/= undefined, Comment ="dhopson@VMUbuntu-DSH comment with whitespaces", Comment = proplists:get_value(comment, Attributes3), @@ -761,7 +761,7 @@ ssh1_auth_keys(Config) when is_list(Config) -> Value1 = proplists:get_value(bits, Attributes2, undefined), Value2 = proplists:get_value(bits, Attributes3, undefined), - true = (Value1 =/= undefined) and (Value2 =/= undefined), + true = Value1 =/= undefined andalso Value2 =/= undefined, Comment2 = Comment3 = "dhopson@VMUbuntu-DSH", Comment4 = Comment5 ="dhopson@VMUbuntu-DSH comment with whitespaces", diff --git a/lib/stdlib/test/beam_lib_SUITE.erl b/lib/stdlib/test/beam_lib_SUITE.erl index 9a568f595fa5..c6157579af6d 100644 --- a/lib/stdlib/test/beam_lib_SUITE.erl +++ b/lib/stdlib/test/beam_lib_SUITE.erl @@ -960,7 +960,7 @@ verify_error(S, R) -> %% Also make sure that formatted message is not just the term printed. Handled = beam_lib:format_error(R) =/= io_lib:format("~p~n", [R]), - true = ((FM > 0) or (BM > 0)) and Handled. + true = (FM > 0 orelse BM > 0) andalso Handled. ver(S, {error, beam_lib, R}) -> [S|_] = tuple_to_list(R), diff --git a/lib/stdlib/test/binary_module_SUITE.erl b/lib/stdlib/test/binary_module_SUITE.erl index 3d9efd919e55..f09c90898306 100644 --- a/lib/stdlib/test/binary_module_SUITE.erl +++ b/lib/stdlib/test/binary_module_SUITE.erl @@ -745,12 +745,13 @@ encode_decode_loop(Range, X) -> R = binary:decode_unsigned(make_unaligned(PaddedLittle),little), S = binref:decode_unsigned(PaddedLittle,little), T = binref:decode_unsigned(PaddedBig), - case (((A =:= B) and (B =:= C) and (C =:= D)) and - ((E =:= F)) and - ((N =:= G) and (G =:= H) and (H =:= I) and - (I =:= J) and (J =:= K) and (K =:= L) and (L =:= M)) and - ((M =:= O) and (O =:= P) and (P =:= Q) and (Q =:= R) and - (R =:= S) and (S =:= T)))of + case (A =:= B andalso B =:= C andalso C =:= D) + andalso (E =:= F) andalso (N =:= G andalso G =:= H andalso H =:= I + andalso I =:= J andalso J =:= K + andalso K =:= L andalso L =:= M) + andalso (M =:= O andalso O =:= P andalso P =:= Q + andalso Q =:= R andalso R =:= S andalso S =:= T) + of true -> encode_decode_loop(Range,X-1); _ -> @@ -1302,7 +1303,7 @@ do_split_comp(N,H,Opts) -> A = ?MASK_ERROR(binref:split(H,N,Opts)), D = ?MASK_ERROR(binary:split(H,binary:compile_pattern(N),Opts)), if - (A =/= [N]) and is_list(A) -> + A =/= [N] andalso is_list(A) -> put(success_counter,get(success_counter)+1); true -> ok @@ -1350,7 +1351,7 @@ do_replace_comp(N,H,R,Opts) -> A = ?MASK_ERROR(binref:replace(H,N,R,Opts)), D = ?MASK_ERROR(binary:replace(H,binary:compile_pattern(N),R,Opts)), if - (A =/= N) and is_binary(A) -> + A =/= N andalso is_binary(A) -> put(success_counter,get(success_counter)+1); true -> ok diff --git a/lib/stdlib/test/binref.erl b/lib/stdlib/test/binref.erl index c92a716dba9e..410cc760a674 100644 --- a/lib/stdlib/test/binref.erl +++ b/lib/stdlib/test/binref.erl @@ -34,7 +34,7 @@ match(Haystack,{Needles},Options) -> match(Haystack,Needles,Options); match(Haystack,Needles,Options) -> try - true = is_binary(Haystack) and is_list(Needles), % badarg, not function_clause + true = is_binary(Haystack) andalso is_list(Needles), % badarg, not function_clause case get_opts_match(Options,nomatch) of nomatch -> mloop(Haystack,Needles); @@ -61,7 +61,7 @@ matches(Haystack,{Needles},Options) -> matches(Haystack,Needles,Options); matches(Haystack,Needles,Options) -> try - true = is_binary(Haystack) and is_list(Needles), % badarg, not function_clause + true = is_binary(Haystack) andalso is_list(Needles), % badarg, not function_clause case get_opts_match(Options,nomatch) of nomatch -> msloop(Haystack,Needles); @@ -377,7 +377,7 @@ list_to_bin(List) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% longest_common_prefix(LB) -> try - true = is_list(LB) and (length(LB) > 0), % Make badarg instead of function clause + true = is_list(LB) andalso length(LB) > 0, % Make badarg instead of function clause do_longest_common_prefix(LB,0) catch _:_ -> @@ -412,7 +412,7 @@ do_lcp([Bin|T],X,Ch) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% longest_common_suffix(LB) -> try - true = is_list(LB) and (length(LB) > 0), % Make badarg instead of function clause + true = is_list(LB) andalso length(LB) > 0, % Make badarg instead of function clause do_longest_common_suffix(LB,0) catch _:_ -> @@ -474,7 +474,7 @@ copy(Subject) -> copy(Subject,1). copy(Subject,N) -> try - true = is_integer(N) and (N >= 0) and is_binary(Subject), % Badarg, not function clause + true = is_integer(N) andalso N >= 0 andalso is_binary(Subject), % Badarg, not function clause erlang:list_to_binary(lists:duplicate(N,Subject)) catch _:_ -> @@ -488,7 +488,7 @@ encode_unsigned(Unsigned) -> encode_unsigned(Unsigned,big). encode_unsigned(Unsigned,Endian) -> try - true = is_integer(Unsigned) and (Unsigned >= 0), + true = is_integer(Unsigned) andalso Unsigned >= 0, if Unsigned =:= 0 -> <<0>>; diff --git a/lib/stdlib/test/erl_eval_SUITE.erl b/lib/stdlib/test/erl_eval_SUITE.erl index 674204ff7c62..72bd3001f515 100644 --- a/lib/stdlib/test/erl_eval_SUITE.erl +++ b/lib/stdlib/test/erl_eval_SUITE.erl @@ -656,10 +656,10 @@ simple_cases(Config) when is_list(Config) -> "(2#101 band 2#10101) bor (2#110 bxor 2#010).", 5), check(fun() -> (2#1 bsl 4) + (2#10000 bsr 3) end, "(2#1 bsl 4) + (2#10000 bsr 3).", 18), - check(fun() -> ((1<3) and ((1 =:= 2) or (1 =/= 2))) xor (1=<2) end, - "((1<3) and ((1 =:= 2) or (1 =/= 2))) xor (1=<2).", false), - check(fun() -> (a /= b) or (2 > 4) or (3 >= 3) end, - "(a /= b) or (2 > 4) or (3 >= 3).", true), + check(fun() -> (1<3 andalso (1 =:= 2 orelse 1 =/= 2)) xor (1=<2) end, + "(1<3 andalso (1 =:= 2 orelse 1 =/= 2)) xor (1=<2).", false), + check(fun() -> a /= b orelse 2 > 4 orelse 3 >= 3 end, + "a /= b orelse 2 > 4 orelse 3 >= 3.", true), check(fun() -> "hej" ++ "san" =/= "hejsan" -- "san" end, "\"hej\" ++ \"san\" =/= \"hejsan\" -- \"san\".", true), check(fun() -> (bnot 1) < -0 end, "(bnot (+1)) < -0.", true), diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index e00aed4b9991..1eb8606ddc79 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -616,7 +616,7 @@ unused_vars_warn_fun(Config) when is_list(Config) -> E; a([A,B,C,D,E]) -> % E unused. fun() -> - (C == <>) andalso (<<17:B>> == D) + C == <> andalso <<17:B>> == D end. ">>, [warn_unused_vars], @@ -1925,8 +1925,8 @@ guard(Config) when is_list(Config) -> {guard7, <<"-record(apa,{}). t() -> - [X || X <- [1,#apa{},3], (3+is_record(X, apa)) orelse - (is_record(X, apa)*2)]. + [X || X <- [1,#apa{},3], 3+is_record(X, apa) orelse + is_record(X, apa)*2]. ">>, [], []}, diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl index ef021aa69170..2bd9bf400206 100644 --- a/lib/stdlib/test/erl_pp_SUITE.erl +++ b/lib/stdlib/test/erl_pp_SUITE.erl @@ -1542,7 +1542,7 @@ pp_expr(List, Options) when is_list(List) -> if PP1 =:= PP2 -> % same line numbers case - (test_max_line(PP1) =:= ok) and (test_new_line(PPneg) =:= ok) + test_max_line(PP1) =:= ok andalso test_new_line(PPneg) =:= ok of true -> ok; diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index db151e9d1499..296d7c017f80 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -5400,8 +5400,8 @@ info_do(Opts) -> end, set, Opts), PublicOrCurr = fun(Curr) -> - case lists:member({write_concurrency, false}, Opts) or - lists:member(private, Opts) or + case lists:member({write_concurrency, false}, Opts) orelse + lists:member(private, Opts) orelse lists:member(protected, Opts) of true -> Curr; false -> public diff --git a/lib/stdlib/test/id_transform_SUITE.erl b/lib/stdlib/test/id_transform_SUITE.erl index a8d52c1680c5..9af52d668198 100644 --- a/lib/stdlib/test/id_transform_SUITE.erl +++ b/lib/stdlib/test/id_transform_SUITE.erl @@ -341,29 +341,29 @@ t2(A) when reference(A); reference(A) -> t2(A) when tuple(A); tuple(A) -> tuple. -t3(A) when is_atom(A) or is_atom(A) -> +t3(A) when is_atom(A) ; is_atom(A) -> is_atom; -t3(A) when is_binary(A) or is_binary(A) -> +t3(A) when is_binary(A) ; is_binary(A) -> is_binary; -t3(A) when is_float(A) or is_float(A) -> +t3(A) when is_float(A) ; is_float(A) -> is_float; -t3(A) when is_function(A) or is_function(A) -> +t3(A) when is_function(A) ; is_function(A) -> is_function; -t3(A) when is_integer(A) or is_integer(A) -> +t3(A) when is_integer(A) ; is_integer(A) -> is_integer; -t3(A) when is_list(A) or is_list(A) -> +t3(A) when is_list(A) ; is_list(A) -> is_list; -t3(A) when is_number(A) or is_number(A) -> +t3(A) when is_number(A) ; is_number(A) -> is_number; -t3(A) when is_pid(A) or is_pid(A) -> +t3(A) when is_pid(A) ; is_pid(A) -> is_pid; -t3(A) when is_port(A) or is_port(A) -> +t3(A) when is_port(A) ; is_port(A) -> is_port; -t3(A) when is_record(A, apa) or is_record(A, apa) -> +t3(A) when is_record(A, apa) ; is_record(A, apa) -> is_record; -t3(A) when is_reference(A) or is_reference(A) -> +t3(A) when is_reference(A) ; is_reference(A) -> is_reference; -t3(A) when is_tuple(A) or is_tuple(A) -> +t3(A) when is_tuple(A) ; is_tuple(A) -> is_tuple; t3(A) when record(A, apa) -> foo; diff --git a/lib/stdlib/test/io_SUITE.erl b/lib/stdlib/test/io_SUITE.erl index ed2edc5cf81f..654370252931 100644 --- a/lib/stdlib/test/io_SUITE.erl +++ b/lib/stdlib/test/io_SUITE.erl @@ -1660,7 +1660,7 @@ g_choice_small(S) when is_list(S) -> El = length(ES), I = list_to_integer(IS), if - El =/= 0, ((I > 9) or (I < -9)) -> + El =/= 0, I > 9 orelse I < -9 -> throw(too_many_digits_before_the_dot); El =/= 0, I =:= 0 -> throw(zero_before_the_dot); diff --git a/lib/stdlib/test/ms_transform_SUITE.erl b/lib/stdlib/test/ms_transform_SUITE.erl index 5e8e6076ae21..c526fc056536 100644 --- a/lib/stdlib/test/ms_transform_SUITE.erl +++ b/lib/stdlib/test/ms_transform_SUITE.erl @@ -778,12 +778,12 @@ float_1_function(Config) when is_list(Config) -> MS1 = compile_and_run (<<"ets:fun2ms(fun(X) -> float(X) end)">>), [F1] = RunMS([3], MS1), - true = is_float(F1) and (F1 == 3), + true = is_float(F1) andalso F1 == 3, MS1b = compile_and_run (<<"dbg:fun2ms(fun(X) -> float(X) end)">>), [F2] = RunMS([3], MS1b), - true = is_float(F2) and (F2 == 3), + true = is_float(F2) andalso F2 == 3, MS2 = compile_and_run (<<"ets:fun2ms(fun(X) when is_pid(X) or float(X) -> true end)">>), diff --git a/lib/stdlib/test/qlc_SUITE.erl b/lib/stdlib/test/qlc_SUITE.erl index bc758cc308e0..daf0c0971f1a 100644 --- a/lib/stdlib/test/qlc_SUITE.erl +++ b/lib/stdlib/test/qlc_SUITE.erl @@ -1439,14 +1439,14 @@ table(Config) when is_list(Config) -> <<"L = [{1,a},{2,b},{3,c}], QH = qlc:q([element(2, X) || X <- qlc_SUITE:table(L, [2]), - (element(1, X) =:= 1) - or (2 =:= element(1, X))]), + element(1, X) =:= 1 + orelse 2 =:= element(1, X)]), [a,b] = lists:sort(qlc:e(QH))">>, <<"etsc(fun(E) -> Q = qlc:q([{A,B} || {A,B} <- qlc:q([{B,A} || {A,B} <- ets:table(E), - (A =:= 1) or (A =:= 2), + A =:= 1 orelse A =:= 2, math:sqrt(B) < A])]), [{2,2}] = qlc:eval(Q), [1,2] = lookup_keys(Q) @@ -2331,17 +2331,17 @@ filter(Config) when is_list(Config) -> [3] = qlc:e(Q) end, [{1,a},{2,b},{3,c}])">>, - <<"Q = qlc:q([X || {X} <- [], (false or (X/0 > 3))]), + <<"Q = qlc:q([X || {X} <- [], X/0 > 3]), \"[]\" = qlc:info(Q), [] = qlc:e(Q)">>, <<"%% match spec [] = qlc:e(qlc:q([X || {X} <- [{1},{2}], - (false orelse (X/0 > 3))])), + X/0 > 3])), %% generated code {'EXIT', {badarith, _}} = (catch qlc:e(qlc:q([X || {X} <- [{1}], - begin (false orelse (X/0 > 3)) end])))">>, + begin X/0 > 3 end])))">>, <<"%% Partial evaluation in filter. etsc(fun(E) -> @@ -2371,7 +2371,6 @@ filter(Config) when is_list(Config) -> <<"%% OTP-5195. Used to return a value, but badarith is correct. etsc(fun(E) -> QH = qlc:q([X || {X,_} <- ets:table(E), - (X =:= 1) and if X =:= 1 -> true; true -> X/0 end]), @@ -2765,7 +2764,7 @@ lookup1(Config) when is_list(Config) -> <<"%% The lookup and max_lookup options interact. etsc(fun(E) -> Q = qlc:q([X || {X} <- ets:table(E), - (X =:= 1) or (X =:= 2)], + X =:= 1 orelse X =:= 2], [{lookup,true},{max_lookup,1}]), {'EXIT', {no_lookup_to_carry_out, _}} = (catch qlc:e(Q)) end, [{1},{2}])">>, @@ -2784,7 +2783,7 @@ lookup1(Config) when is_list(Config) -> <<"etsc(fun(E) -> Q = qlc:q([{A,B,D} || {A,B}={D,A} <- ets:table(E), - (D =:= 2) or (B =:= 1)], + D =:= 2 orelse B =:= 1], {max_lookup,infinity}), [{1,1,1},{2,2,2}] = qlc:eval(Q), [1,2] = lookup_keys(Q) @@ -2993,7 +2992,7 @@ lookup2(Config) when is_list(Config) -> <<"etsc(fun(E) -> Q = qlc:q([{A,B,D} || {A,B}={D,A} <- ets:table(E), - (A =:= 3) or (4 =:= D)]), + A =:= 3 orelse 4 =:= D]), [{3,3,3},{4,4,4}] = lists:sort(qlc:e(Q)), [3,4] = lookup_keys(Q) end, [{2,2},{3,3},{4,4}])">>, @@ -3036,7 +3035,7 @@ lookup2(Config) when is_list(Config) -> <<"etsc(fun(E) -> Q = qlc:q([{X,Y} || {X,Y} <- ets:table(E), - ({X,3} =:= {Y,Y}) or (X =:= 4)]), + {X,3} =:= {Y,Y} orelse X =:= 4]), [{3,3},{4,4}] = lists:sort(qlc:e(Q)), [3,4] = lookup_keys(Q) end, [{2,2},{3,3},{4,4},{5,5}])">>, @@ -3075,8 +3074,8 @@ lookup2(Config) when is_list(Config) -> {cres, <<"etsc(fun(E) -> Q = qlc:q([X || {X} <- ets:table(E), - (3 =:= X) or (X =:= 12), - (8 =:= X) or (X =:= 10)]), + 3 =:= X orelse X =:= 12, + 8 =:= X orelse X =:= 10]), [] = lists:sort(qlc:e(Q)), false = lookup_keys(Q) end, [{2},{3},{4},{8}])">>, @@ -3086,8 +3085,8 @@ lookup2(Config) when is_list(Config) -> {cres, <<"etsc(fun(E) -> Q = qlc:q([X || {X} <- ets:table(E), - ((3 =:= X) or (X =:= 12)) - and ((8 =:= X) or (X =:= 10))]), + (3 =:= X orelse X =:= 12) + andalso (8 =:= X orelse X =:= 10)]), [] = lists:sort(qlc:e(Q)), false = lookup_keys(Q) end, [{2},{3},{4},{8}])">>, @@ -3229,8 +3228,8 @@ lookup2(Config) when is_list(Config) -> <<"etsc(fun(E) -> Q = qlc:q([X || {{X,Y}} <- ets:table(E), - (X =:= 1) and (Y =:= 2) - or (X =:= 3) and (Y =:= 4)]), + X =:= 1 andalso Y =:= 2 + orelse X =:= 3 andalso Y =:= 4]), [1,3] = lists:sort(qlc:e(Q)), [{1,2}, {3,4}] = lookup_keys(Q) end, [{{1,2}}, {{3,4}}, {{2,3}}])">>, @@ -3250,8 +3249,8 @@ lookup2(Config) when is_list(Config) -> <<"etsc(fun(E) -> Q = qlc:q([X || {{X,Y},_Z} <- ets:table(E), - (X =:= 3) and (Y =:= a) - or (X =:= 4) and (Y =:= a)]), + X =:= 3 andalso Y =:= a + orelse X =:= 4 andalso Y =:= a]), [3,4] = qlc:e(Q), [{3,a}, {4,a}] = lookup_keys(Q) end, [{{3,a},3}, {{4,a},3}])">>, @@ -3259,7 +3258,7 @@ lookup2(Config) when is_list(Config) -> {cres, <<"etsc(fun(E) -> Q = qlc:q([X || {X} <- ets:table(E), - (X =:= 3) and (X =:= a)]), + X =:= 3 andalso X =:= a]), [] = qlc:e(Q), false = lookup_keys(Q) end, [{3}, {4}])">>, @@ -3268,35 +3267,35 @@ lookup2(Config) when is_list(Config) -> <<"etsc(fun(E) -> Q = qlc:q([X || {{X,Y}} <- ets:table(E), - X =:= 3, ((Y =:= a) or (Y =:= b))]), + X =:= 3, Y =:= a orelse Y =:= b]), [3,3] = qlc:e(Q), [{3,a},{3,b}] = lists:sort(lookup_keys(Q)) end, [{{3,a}},{{2,b}},{{3,b}}])">>, <<"etsc(fun(E) -> Q = qlc:q([X || {X,Y} <- ets:table(E), - ((X =:= 3) or (Y =:= 4)) and (X == a)]), + (X =:= 3 orelse Y =:= 4) andalso X == a]), [a] = qlc:e(Q), [a] = lookup_keys(Q) end, [{a,4},{3,3}])">>, <<"etsc(fun(E) -> Q = qlc:q([X || {X,Y} <- ets:table(E), - (X =:= 3) or ((Y =:= 4) and (X == a))]), + X =:= 3 orelse (Y =:= 4 andalso X == a)]), [3,a] = lists:sort(qlc:e(Q)), [3,a] = lookup_keys(Q) end, [{a,4},{3,3}])">>, <<"etsc(fun(E) -> Q = qlc:q([X || {{X,Y}} <- ets:table(E), - (X =:= 3) or ((Y =:= 4) and (X == a))]), + X =:= 3 orelse (Y =:= 4 andalso X == a)]), [3,a] = lists:sort(qlc:e(Q)), false = lookup_keys(Q) end, [{{3,a}},{{2,b}},{{a,4}}])">>, <<"etsc(fun(E) -> Q = qlc:q([X || {{X,Y}} <- ets:table(E), - ((X =:= 3) or (Y =:= 4)) and (X == a)]), + (X =:= 3 orelse Y =:= 4) andalso X == a]), [a] = lists:sort(qlc:e(Q)), [{a,4}] = lookup_keys(Q) end, [{{3,a}},{{2,b}},{{a,4}}])">>, @@ -3305,12 +3304,12 @@ lookup2(Config) when is_list(Config) -> NoAnswers = 3*3*3+2*2*2, Q = qlc:q([{X,Y,Z} || {{X,Y,Z}} <- ets:table(E), - (((X =:= 4) or (X =:= 5)) and - ((Y =:= 4) or (Y =:= 5)) and - ((Z =:= 4) or (Z =:= 5))) or - (((X =:= 1) or (X =:= 2) or (X =:= 3)) and - ((Y =:= 1) or (Y =:= 2) or (Y =:= 3)) and - ((Z =:= 1) or (Z =:= 2) or (Z =:= 3)))], + ((X =:= 4 orelse X =:= 5) andalso + (Y =:= 4 orelse Y =:= 5) andalso + (Z =:= 4 orelse Z =:= 5)) orelse + ((X =:= 1 orelse X =:= 2 orelse X =:= 3) andalso + (Y =:= 1 orelse Y =:= 2 orelse Y =:= 3) andalso + (Z =:= 1 orelse Z =:= 2 orelse Z =:= 3))], {max_lookup, NoAnswers}), {list, {table, _}, _} = i(Q), [{1,1,1},{2,2,2},{3,3,3}] = lists:sort(qlc:e(Q)), @@ -3320,12 +3319,12 @@ lookup2(Config) when is_list(Config) -> <<"etsc(fun(E) -> Q = qlc:q([{X,Y,Z} || {{X,Y,Z}} <- ets:table(E), - (((X =:= 4) or (X =:= 5)) and - ((Y =:= 4) or (Y =:= 5)) and - ((Z =:= 4) or (Z =:= 5))) or - (((X =:= 1) or (X =:= 2) or (X =:= 3)) and - ((Y =:= 1) or (Y =:= 2) or (Y =:= 3)) and - ((Z =:= 1) or (Z =:= 2) or (Z =:= 3)))], + ((X =:= 4 orelse X =:= 5) andalso + (Y =:= 4 orelse Y =:= 5) andalso + (Z =:= 4 orelse Z =:= 5)) orelse + ((X =:= 1 orelse X =:= 2 orelse X =:= 3) andalso + (Y =:= 1 orelse Y =:= 2 orelse Y =:= 3) andalso + (Z =:= 1 orelse Z =:= 2 orelse Z =:= 3))], {max_lookup, 10}), [{1,1,1},{2,2,2},{3,3,3}] = lists:sort(qlc:e(Q)), {table,{ets,table,[_,[{traverse,{select,_}}]]}} = i(Q) @@ -3358,8 +3357,8 @@ lookup2(Config) when is_list(Config) -> <<"etsc(fun(E) -> A = a, B = a, Q = qlc:q([X || {{X,Y}} <- ets:table(E), - ((X =:= A) and (Y =:= B)) - or ((X =:= B) and (Y =:= A))]), + (X =:= A andalso Y =:= B) + orelse (X =:= B andalso Y =:= A)]), [a] = qlc:e(Q), %% keys are usorted, duplicate removed: [{a,a}] = lookup_keys(Q) @@ -3368,8 +3367,8 @@ lookup2(Config) when is_list(Config) -> <<"etsc(fun(E) -> A = a, B = b, Q = qlc:q([X || {{X,Y}} <- ets:table(E), - ((X =:= A) and (Y =:= B)) - or ((X =:= B) and (Y =:= A))]), + (X =:= A andalso Y =:= B) + orelse (X =:= B andalso Y =:= A)]), [a,b] = lists:sort(qlc:e(Q)), [{a,b},{b,a}] = lookup_keys(Q) end, [{{a,b}},{{b,a}},{{c,a}},{{d,b}}])">>, @@ -3431,8 +3430,8 @@ lookup2(Config) when is_list(Config) -> <<"etsc(fun(E) -> Q0 = qlc:q([X || X <- ets:table(E), - (element(1, X) =:= 1) or - (element(1, X) =:= 2)], + element(1, X) =:= 1 orelse + element(1, X) =:= 2], {cache,ets}), Q = qlc:q([{X,Y} || X <- [1,2], @@ -3446,8 +3445,8 @@ lookup2(Config) when is_list(Config) -> <<"etsc(fun(E) -> Q0 = qlc:q([X || X <- ets:table(E), - (element(1, X) =:= 1) or - (element(1, X) =:= 2)]), + element(1, X) =:= 1 orelse + element(1, X) =:= 2]), Q = qlc:q([{X,Y} || X <- [1,2], Y <- Q0], @@ -3464,7 +3463,7 @@ lookup2(Config) when is_list(Config) -> Q = qlc:q([{X,Y} || X <- [1,2], {Y} <- ets:table(E), - (Y =:= 1) or (Y =:= 2)], + Y =:= 1 orelse Y =:= 2], []), [{1,1},{1,2},{2,1},{2,2}] = qlc:e(Q), {qlc,_,[{generate,_,{list,[1,2]}}, @@ -3477,7 +3476,7 @@ lookup2(Config) when is_list(Config) -> Q = qlc:q([{X,Y} || X <- [1,2], {Y} <- ets:table(E), - (Y =:= 1) or (Y =:= 2)], + Y =:= 1 orelse Y =:= 2], [cache]), [{1,1},{1,2},{2,1},{2,2}] = qlc:e(Q), {qlc,_,[{generate,_,{list,[1,2]}}, @@ -3490,8 +3489,8 @@ lookup2(Config) when is_list(Config) -> Q = qlc:q([{X,Y} || X <- [1,2], Y <- ets:table(E), - (element(1, Y) =:= 1) - or (element(1, Y) =:= 2)], + element(1, Y) =:= 1 + orelse element(1, Y) =:= 2], []), [{1,{1}},{1,{2}},{2,{1}},{2,{2}}] = qlc:e(Q), {qlc,_,[{generate,_,{list,[1,2]}}, @@ -3504,8 +3503,8 @@ lookup2(Config) when is_list(Config) -> Q = qlc:q([{X,Y} || X <- [1,2], Y <- ets:table(E), - (element(1, Y) =:= 1) - or (element(1, Y) =:= 2)], + element(1, Y) =:= 1 + orelse element(1, Y) =:= 2], [cache]), {qlc,_,[{generate,_,{list,[1,2]}}, {generate,_,{table,_}}],[]} = i(Q), @@ -3655,7 +3654,7 @@ lookup_rec(Config) when is_list(Config) -> Ts = [ <<"etsc(fun(E) -> Q = qlc:q([A || #r{a = A} <- ets:table(E), - (A =:= 3) or (4 =:= A)]), + A =:= 3 orelse 4 =:= A]), [3] = qlc:e(Q), [3,4] = lookup_keys(Q) end, [{keypos,2}], [#r{a = a}, #r{a = 3}, #r{a = 5}])">>, @@ -3663,7 +3662,7 @@ lookup_rec(Config) when is_list(Config) -> {cres, <<"etsc(fun(E) -> Q = qlc:q([A || #r{a = 17 = A} <- ets:table(E), - (A =:= 3) or (4 =:= A)]), + A =:= 3 orelse 4 =:= A]), [] = qlc:e(Q), false = lookup_keys(Q) end, [{keypos,2}], [#r{a = 17}, #r{a = 3}, #r{a = 5}])">>, @@ -3673,7 +3672,7 @@ lookup_rec(Config) when is_list(Config) -> <<"%% Compares an integer and a float. etsc(fun(E) -> Q = qlc:q([A || #r{a = 17 = A} <- ets:table(E), - (A == 17) or (17.0 == A)]), + A == 17 orelse 17.0 == A]), [_] = qlc:e(Q), [_] = lookup_keys(Q) end, [{keypos,2}], [#r{a = 17}, #r{a = 3}, #r{a = 5}])">>, @@ -3683,7 +3682,7 @@ lookup_rec(Config) when is_list(Config) -> %% that case is handled in an earlier clause (unify ... E, E). etsc(fun(E) -> Q = qlc:q([A || #r{a = 17.0 = A} <- ets:table(E), - (A =:= 17) or (17.0 =:= A)]), + A =:= 17 orelse 17.0 =:= A]), [_] = qlc:e(Q), [_] = lookup_keys(Q) end, [{keypos,2}], [#r{a = 17.0}, #r{a = 3}, #r{a = 5}])">>, @@ -3691,7 +3690,7 @@ lookup_rec(Config) when is_list(Config) -> <<"%% Matches an integer and a float. etsc(fun(E) -> Q = qlc:q([A || #r{a = 17 = A} <- ets:table(E), - (A =:= 17) or (17.0 =:= A)]), + A =:= 17 orelse 17.0 =:= A]), [_] = qlc:e(Q), [_] = lookup_keys(Q) end, [{keypos,2}], [#r{a = 17}, #r{a = 3}, #r{a = 5}])">>, @@ -3699,7 +3698,7 @@ lookup_rec(Config) when is_list(Config) -> <<"etsc(fun(E) -> F = fun(_) -> 17 end, Q = qlc:q([A || #r{a = A} <- ets:table(E), - (F(A) =:= 3) and (A =:= 4)]), + F(A) =:= 3 andalso A =:= 4]), [] = qlc:e(Q), false = lookup_keys(Q) % F(A) could fail end, [{keypos,2}], [#r{a = 4}, #r{a = 3}, #r{a = 5}])">>, @@ -3726,15 +3725,15 @@ indices(Config) when is_list(Config) -> Ts = [ <<"L = [{1,a},{2,b},{3,c}], QH = qlc:q([element(1, X) || X <- qlc_SUITE:table(L, [2]), - (element(2, X) =:= a) - or (b =:= element(2, X))]), + element(2, X) =:= a + orelse b =:= element(2, X)]), {list, {table,{qlc_SUITE,list_keys,[[a,b],2,L]}}, _MS} = i(QH), [1,2] = qlc:eval(QH)">>, <<"L = [{1,a},{2,b},{3,c}], QH = qlc:q([element(1, X) || X <- qlc_SUITE:table(L, [2]), - begin (element(2, X) =:= a) - or (b =:= element(2, X)) end]), + begin element(2, X) =:= a + orelse b =:= element(2, X) end]), {qlc,_,[{generate,_,{table,{call,_, {remote,_,_,{atom,_,the_list}},_}}},_],[]} = i(QH), @@ -3742,42 +3741,42 @@ indices(Config) when is_list(Config) -> <<"L = [{1,a,q},{2,b,r},{3,c,s}], QH = qlc:q([element(1, X) || X <- qlc_SUITE:table(L, [2,3]), - (element(3, X) =:= q) - or (r =:= element(3, X))]), + element(3, X) =:= q + orelse r =:= element(3, X)]), {list, {table,{qlc_SUITE,list_keys, [[q,r],3,L]}}, _MS} = i(QH), [1,2] = qlc:eval(QH)">>, <<"L = [{1,a,q},{2,b,r},{3,c,s}], QH = qlc:q([element(1, X) || X <- qlc_SUITE:table(L, 1, [2]), - (element(3, X) =:= q) - or (r =:= element(3, X))]), + element(3, X) =:= q + orelse r =:= element(3, X)]), {qlc,_,[{generate,_,{table,{call,_,_,_}}}, _],[]} = i(QH), [1,2] = qlc:eval(QH)">>, <<"L = [{a,1},{b,2},{c,3}], QH = qlc:q([E || {K,I}=E <- qlc_SUITE:table(L, 1, [2]), - ((K =:= a) or (K =:= b) or (K =:= c)) - and ((I =:= 1) or (I =:= 2))], + (K =:= a orelse K =:= b orelse K =:= c) + andalso (I =:= 1 orelse I =:= 2)], {max_lookup, 3}), {list, {table,{qlc_SUITE,list_keys,[[a,b,c],1,L]}}, _MS} = i(QH), [{a,1},{b,2}] = qlc:eval(QH)">>, <<"L = [{a,1},{b,2},{c,3}], QH = qlc:q([E || {K,I}=E <- qlc_SUITE:table(L, 1, [2]), - ((K =:= a) or (K =:= b) or (K =:= c)) - and ((I =:= 1) or (I =:= 2))], + (K =:= a orelse K =:= b orelse K =:= c) + andalso (I =:= 1 orelse I =:= 2)], {max_lookup, 2}), {list, {table,{qlc_SUITE,list_keys, [[1,2],2,L]}}, _MS} = i(QH), [{a,1},{b,2}] = qlc:eval(QH)">>, <<"L = [{a,1,x,u},{b,2,y,v},{c,3,z,w}], QH = qlc:q([E || {K,I1,I2,I3}=E <- qlc_SUITE:table(L, 1, [2,3,4]), - ((K =/= a) or (K =/= b) or (K =/= c)) - and ((I1 =:= 1) or (I1 =:= 2) or - (I1 =:= 3) or (I1 =:= 4)) - and ((I2 =:= x) or (I2 =:= z)) - and ((I3 =:= v) or (I3 =:= w))], + (K =/= a orelse K =/= b orelse K =/= c) + andalso (I1 =:= 1 orelse I1 =:= 2 orelse + I1 =:= 3 orelse I1 =:= 4) + andalso (I2 =:= x orelse I2 =:= z) + andalso (I3 =:= v orelse I3 =:= w)], {max_lookup, 5}), {list, {table,{qlc_SUITE,list_keys, [[x,z],3,L]}}, _MS} = i(QH), [{c,3,z,w}] = qlc:eval(QH)">> @@ -3795,8 +3794,8 @@ pre_fun(Config) when is_list(Config) -> F1 = fun() -> QH = qlc:q([element(1, X) || X <- qlc_SUITE:table_kill_parent(L, [2]), - (element(2, X) =:= a) - or (b =:= element(2, X))]), + element(2, X) =:= a + orelse b =:= element(2, X)]), _ = qlc:info(QH), _ = qlc:cursor(QH) end, @@ -3813,8 +3812,8 @@ pre_fun(Config) when is_list(Config) -> F2 = fun() -> QH = qlc:q([element(1, X) || X <- qlc_SUITE:table_kill_parent(L, [2]), - (element(2, X) =:= a) - or (b =:= element(2, X))]), + element(2, X) =:= a + orelse b =:= element(2, X)]), _ = qlc:eval(QH) end, Pid2 = spawn_link(F2), @@ -3826,8 +3825,8 @@ pre_fun(Config) when is_list(Config) -> <<"L = [{1,a},{2,b},{3,c}], QH = qlc:q([element(1, X) || X <- qlc_SUITE:table_parent_throws(L, [2]), - (element(2, X) =:= a) - or (b =:= element(2, X))]), + element(2, X) =:= a + orelse b =:= element(2, X)]), _ = qlc:info(QH), {throw,thrown} = (catch {any_term,qlc:cursor(QH)}), {throw,thrown} = (catch {any_term,qlc:eval(QH)})">>, @@ -3835,8 +3834,8 @@ pre_fun(Config) when is_list(Config) -> <<"L = [{1,a},{2,b},{3,c}], QH = qlc:q([element(1, X) || X <- qlc_SUITE:table_parent_exits(L, [2]), - (element(2, X) =:= a) - or (b =:= element(2, X))]), + element(2, X) =:= a + orelse b =:= element(2, X)]), _ = qlc:info(QH), {'EXIT', {badarith,_}} = (catch qlc:cursor(QH)), {'EXIT', {badarith,_}} = (catch qlc:eval(QH))">>, @@ -3844,8 +3843,8 @@ pre_fun(Config) when is_list(Config) -> <<"L = [{1,a},{2,b},{3,c}], QH = qlc:q([element(1, X) || X <- qlc_SUITE:table_bad_parent_fun(L, [2]), - (element(2, X) =:= a) - or (b =:= element(2, X))]), + element(2, X) =:= a + orelse b =:= element(2, X)]), {'EXIT', {badarg,_}} = (catch qlc:cursor(QH)), {'EXIT', {badarg,_}} = (catch qlc:eval(QH))">>, @@ -3880,7 +3879,7 @@ skip_filters(Config) when is_list(Config) -> %% The filter can be skipped. Just a lookup remains. <<"etsc(fun(E) -> H = qlc:q([X || X <- ets:table(E), - (element(1, X) =:= 1) or (element(1, X) =:= 1)]), + element(1, X) =:= 1 orelse element(1, X) =:= 1]), [{1}] = qlc:eval(H), {table, _} = i(H), [1] = lookup_keys(H) @@ -3889,7 +3888,7 @@ skip_filters(Config) when is_list(Config) -> %% safe_unify fails on 3 and <> <<"etsc(fun(E) -> H = qlc:q([X || X <- ets:table(E), - (element(1, X) =:= 1) and (3 =:= <>)]), + element(1, X) =:= 1 andalso 3 =:= <>]), [] = qlc:eval(H), [1] = lookup_keys(H) end, [{keypos,1}], [{1},{2}])">>, @@ -3897,8 +3896,8 @@ skip_filters(Config) when is_list(Config) -> %% Two filters are skipped. <<"etsc(fun(E) -> Q = qlc:q([{B,C,D} || {A={C},B} <- ets:table(E), - (A =:= {1}) or (A =:= {2}), - (C =:= 1) or (C =:= 2), + A =:= {1} orelse A =:= {2}, + C =:= 1 orelse C =:= 2, D <- [1,2]]), {qlc,_,[{generate,_,{table,_}},{generate,_,{list,[1,2]}}],[]} = i(Q), @@ -3908,8 +3907,8 @@ skip_filters(Config) when is_list(Config) -> <<"etsc(fun(E) -> Q = qlc:q([{B,C} || {A={C},B} <- ets:table(E), - (A =:= {1}) or (A =:= {2}), - (C =:= 1) or (C =:= 2)]), + A =:= {1} orelse A =:= {2}, + C =:= 1 orelse C =:= 2]), {qlc,_,[{generate,_,{table,_}}],[]} = i(Q), [{1,1},{2,2}] = lists:sort(qlc:eval(Q)), [{1},{2}] = lookup_keys(Q) @@ -3997,21 +3996,21 @@ skip_filters(Config) when is_list(Config) -> <<"etsc(fun(E) -> H = qlc:q([X || {X,_} <- ets:table(E), - ((X =:= 2) or (X =:= 1)) and (X > 1)]), + (X =:= 2 orelse X =:= 1) andalso X > 1]), {list,{table,_},_} = i(H), [2] = qlc:e(H) end, [{1,a},{2,b}])">>, <<"etsc(fun(E) -> H = qlc:q([X || {X,Y} <- ets:table(E), - (X =:= 2) and (Y =:= b)]), + X =:= 2 andalso Y =:= b]), {list,{table,_},_} = i(H), [2] = qlc:e(H) end, [{1,a},{2,b}])">>, <<"etsc(fun(E) -> H = qlc:q([X || X <- ets:table(E), - (element(1,X) =:= 2) and (X =:= {2,b})]), + element(1,X) =:= 2 andalso X =:= {2,b}]), {list,{table,_},_} = i(H), [{2,b}] = qlc:e(H) end, [{1,a},{2,b}])">>, @@ -4020,7 +4019,7 @@ skip_filters(Config) when is_list(Config) -> H = qlc:q([{X,Y,Z,W} || {X,Y} <- ets:table(E), {Z,W} <- ets:table(E), - (Y =:= 3) or (Y =:= 4)]), + Y =:= 3 orelse Y =:= 4]), {qlc,_,[{generate,_,{table,{ets,table,_}}}, {generate,_,{table,{ets,table,_}}}],[]} = i(H), [{a,3,a,3},{a,3,b,5}] = lists:sort(qlc:e(H)) @@ -4075,8 +4074,8 @@ skip_filters(Config) when is_list(Config) -> H = qlc:q([{X,Y,Z,W} || {X,_}=Z <- ets:table(E1), W={Y} <- ets:table(E2), - (X =:= 1) or (X =:= 2), - (Y =:= a) or (Y =:= b)] + X =:= 1 orelse X =:= 2, + Y =:= a orelse Y =:= b] ,{lookup,true} ), {qlc,_,[{generate,_,{list,{table,_}, @@ -4099,10 +4098,10 @@ skip_filters(Config) when is_list(Config) -> Z > 2, X <- ets:table(E1), Y <- ets:table(E2), - (element(1, X) =:= 1) or - (element(1, X) =:= 2), - (element(1, Y) =:= a) or - (element(1, Y) =:= b)] + element(1, X) =:= 1 orelse + element(1, X) =:= 2, + element(1, Y) =:= a orelse + element(1, Y) =:= b] ,{lookup,true} ), {qlc,_,[_,{generate,_,{table,_}}, @@ -4121,8 +4120,8 @@ skip_filters(Config) when is_list(Config) -> H = qlc:q([{X,Y,Z,W} || {X,V}=Z <- ets:table(E1), W={Y} <- ets:table(E2), - (X =:= 1) or (X =:= 2), - (Y =:= a) or (Y =:= b), + X =:= 1 orelse X =:= 2, + Y =:= a orelse Y =:= b, Y =:= V] ,[{lookup,true},{join,merge}] ), @@ -4156,28 +4155,28 @@ skip_filters(Config) when is_list(Config) -> <<"etsc(fun(E) -> H = qlc:q([X || {X=_,_} <- ets:table(E), % no matchspec - (X =:= 3) and (X > 3)]), + X =:= 3 andalso X > 3]), {qlc,_,[{generate,_,{table,_}},_],[]} = i(H), [] = qlc:e(H) end, [{3,a},{4,b}])">>, <<"etsc(fun(E) -> H = qlc:q([X || {X=_,_} <- ets:table(E), % no matchspec - (X =:= 3) or true]), + X =:= 3 orelse true]), {qlc,_,[{generate,_,{table,{ets,table,_}}},_],[]} = i(H), [3,4] = lists:sort(qlc:e(H)) end, [{3,a},{4,b}])">>, <<"etsc(fun(E) -> H = qlc:q([X || {X=_,_} <- ets:table(E), % no matchspec - (X =:= 3) or false]), + X =:= 3 orelse false]), {qlc,_,[{generate,_,{table,_}}],[]} = i(H), [3] = lists:sort(qlc:e(H)) end, [{3,a},{4,b}])">>, <<"etsc(fun(E) -> H = qlc:q([X || {X=_,_} <- ets:table(E), % no matchspec - (X =:= X) and (X =:= 3)]), + X =:= X andalso X =:= 3]), {qlc,_,[{generate,_,{table,_}}],[]} = i(H), [3] = lists:sort(qlc:e(H)) end, [{3,a},{4,b}])">>, @@ -4289,10 +4288,10 @@ ets(Config) when is_list(Config) -> i(qlc:q([X || {X} <- ets:table(E, {n_objects,1})])), {qlc,_,[{generate,_,{table,{ets,table,[_,{n_objects,1}]}}},_],[]} = i(qlc:q([X || {X} <- ets:table(E,{n_objects,1}), - begin (X >= 1) or (X < 1) end])), + begin X >= 1 orelse X < 1 end])), {qlc,_,[{generate,_,{table,{ets,table,[_]}}},_],[]} = i(qlc:q([X || {X} <- ets:table(E), - begin (X >= 1) or (X < 1) end])), + begin X >= 1 orelse X < 1 end])), ets:delete(E)">>, begin @@ -4350,16 +4349,16 @@ dets(Config) when is_list(Config) -> i(qlc:q([X || {X} <- dets:table(T, {n_objects,1})])), {qlc,_,[{generate,_,{table,{dets,table,[t,{n_objects,1}]}}},_],[]}= i(qlc:q([X || {X} <- dets:table(T,{n_objects,1}), - begin (X >= 1) or (X < 1) end])), + begin X >= 1 orelse X < 1 end])), {qlc,_,[{generate,_,{table,{dets,table,[_]}}},_],[]} = i(qlc:q([X || {X} <- dets:table(T), - begin (X >= 1) or (X < 1) end])), + begin X >= 1 orelse X < 1 end])), H = qlc:q([X || {X} <- dets:table(T, {n_objects, default}), - begin (X =:= 1) or (X =:= 2) or (X =:= 3) end]), + begin X =:= 1 orelse X =:= 2 orelse X =:= 3 end]), [1,2] = lists:sort(qlc:e(H)), {qlc,_,[{generate,_,{table,_}},_],[]} = i(H), - H2 = qlc:q([X || {X} <- dets:table(T), (X =:= 1) or (X =:= 2)]), + H2 = qlc:q([X || {X} <- dets:table(T), X =:= 1 orelse X =:= 2]), [1,2] = lists:sort(qlc:e(H2)), {list,{table,_},_} = i(H2), true = binary_to_list(<< @@ -4516,8 +4515,8 @@ join_option(Config) when is_list(Config) -> %% X and Y are \"equal\" (same constants), but must not be joined. Q13 = qlc:q([{X,Y} || {X,_Z} <- [{a,1},{a,2},{b,1},{b,2}], {Y} <- [{a}], - (X =:= a) and (Y =:= b) or - (X =:= b) and (Y =:= a)], + X =:= a andalso Y =:= b orelse + X =:= b andalso Y =:= a], {join,merge}), {'EXIT', {no_join_to_carry_out, _}} = (catch qlc:e(Q13)) @@ -4669,9 +4668,9 @@ join_lookup(Config) when is_list(Config) -> E2 = qlc_SUITE:table([{1,a},{a},{1,b},{b}], 2, []), Q = qlc:q([{X,Y} || {X,Y} <- ets:table(E1), % (1) {_,Z} <- E2, % (2) - (Z =:= Y) and (X =:= a) - or - (Z =:= Y) and (X =:= b)]), + Z =:= Y andalso X =:= a + orelse + Z =:= Y andalso X =:= b]), %% Cannot look up in (1) (X is keypos). Can look up (2). %% Lookup-join: traverse (1), look up in (2). {0,1,0,0} = join_info_count(Q), @@ -4940,11 +4939,11 @@ join_merge(Config) when is_list(Config) -> etsc(fun(E2) -> Q = qlc:q([{X,Y} || {X,Y} <- ets:table(E1), % (1) {Z} <- ets:table(E2), % (2) - (Z =:= X) and - (Y =:= a) and - (X =:= Y) or - (Y =:= b) and - (Z =:= Y)]), + Z =:= X andalso + Y =:= a andalso + X =:= Y orelse + Y =:= b andalso + Z =:= Y]), %% Cannot look up in (1) (X is keypos). Can look up (2). %% Lookup join not possible (cannot look up in (1)). %% Merge join is possible (after lookup in (2)). @@ -5465,7 +5464,7 @@ join_sort(Config) when is_list(Config) -> <<"QH = qlc:q([{X,Y} || {X,Y} <- [{1,4},{1,3}], {Z} <- [{1}], - X =:= Z, (Y =:= 3) or (Y =:= 4)]), + X =:= Z, Y =:= 3 orelse Y =:= 4]), {1,0,0,1} = join_info_count(QH), [{1,4},{1,3}] = qlc:e(QH)">>, @@ -5605,7 +5604,7 @@ join_sort(Config) when is_list(Config) -> L = [{a,b,a},{c,d,b},{1,2,a},{3,4,b}], Q = qlc:q([P1 || {X,2,Z}=P1 <- ets:table(E), Y <- L, - (X =:= 1) or (X =:= 2), + X =:= 1 orelse X =:= 2, Z =:= a, P1 =:= Y, X =:= element(1, Y)]), @@ -6233,7 +6232,7 @@ otp_7238(Config) when is_list(Config) -> {nomatch_10, <<"nomatch_10() -> qlc:q([X || X <- [], - ((X =:= 1) or (X =:= 2)) and (X =:= 3)]).">>, + (X =:= 1 orelse X =:= 2) andalso X =:= 3]).">>, [], %% {warnings,[{{3,53},qlc,nomatch_filter}]}}, []}, @@ -6383,7 +6382,7 @@ otp_7238(Config) when is_list(Config) -> <<"F = fun(D) -> etsc(fun(E) -> Q = qlc:q([C || {N,C} <- ets:table(E), - (N =:= {2,2}) or (N =:= {3,3})]), + N =:= {2,2} orelse N =:= {3,3}]), F = qlc:info(Q, [{format,abstract_code},{depth,D}]), {call,_,_,[{call,_,_,[_Fun,Values]},_]} = F, [b,c] = lists:sort(qlc:eval(Q)), @@ -6409,7 +6408,7 @@ otp_7238(Config) when is_list(Config) -> {ok, _} = dets:open_file(T, [{file,Fname}]), ok = dets:insert(T, [{{1,1},a},{{2,2},b},{{3,3},c},{{4,4},d}]), Q = qlc:q([C || {N,C} <- dets:table(T), - (N =:= {2,2}) or (N =:= {3,3})]), + N =:= {2,2} orelse N =:= {3,3}]), F = qlc:info(Q, [{format,abstract_code},{depth,1}]), [b,c] = lists:sort(qlc:eval(Q)), {call,_,_, @@ -6425,8 +6424,8 @@ otp_7238(Config) when is_list(Config) -> %% Thirdly: format_fun has been extended (in particular: gb_table) <<"T = gb_trees:from_orddict([{{1,a},w},{{2,b},v},{{3,c},u}]), QH = qlc:q([X || {{X,Y},_} <- gb_table:table(T), - ((X =:= 1) or (X =:= 2)), - ((Y =:= a) or (Y =:= b) or (Y =:= c))]), + (X =:= 1 orelse X =:= 2), + (Y =:= a orelse Y =:= b orelse Y =:= c)]), {call,_,_, [{call,_,_, [{'fun',_, @@ -6485,7 +6484,7 @@ otp_7238(Config) when is_list(Config) -> <<"L = [{{key,1},a},{{key,2},b},{{key,3},c}], T = gb_trees:from_orddict(orddict:from_list(L)), Q = qlc:q([K || {K,_} <- gb_table:table(T), - (K =:= {key,1}) or (K =:= {key,2})]), + K =:= {key,1} orelse K =:= {key,2}]), {call,_,_, [{call,_,_, [{'fun',_, @@ -6633,7 +6632,7 @@ otp_11758(Config) when is_list(Config) -> L = [{rrr, xxx, aaa}, {rrr, yyy, bbb}], true = ets:insert(T, L), QH = qlc:q([{rrr, B, C} || {rrr, B, C} <- ets:table(T), - (B =:= xxx) or (B =:= yyy) and (C =:= aaa)]), + B =:= xxx orelse B =:= yyy andalso C =:= aaa]), [{rrr,xxx,aaa}] = qlc:e(QH), ets:delete(T)">>], run(Config, Ts). @@ -6816,8 +6815,8 @@ otp_6674(Config) when is_list(Config) -> <<"T = gb_trees:from_orddict([{foo,{1}}, {bar,{2}}]), Q = qlc:q([{X,Y} || {_,X} <- gb_table:table(T), {Y} <- [{{1}},{{2}},{{1.0}},{{2.0}}], - (X =:= {1}) or (X == {2}), - (X == {1.0}) or (X =:= {2.0}), + X =:= {1} orelse X == {2}, + X == {1.0} orelse X =:= {2.0}, X == Y], {join, merge}), [{{1},{1}},{{1},{1.0}}] = qlc:e(Q)">>, @@ -7047,7 +7046,7 @@ otp_6674(Config) when is_list(Config) -> <<"etsc(fun(E) -> Q = qlc:q([X || {X,Y} <- ets:table(E), - ((X =:= 3) or (Y =:= 4)) and (X == a)]), + (X =:= 3 orelse Y =:= 4) andalso X == a]), {list,{table,_},_} = i(Q), [] = qlc:e(Q), % a is not an answer [a] = lookup_keys(Q) @@ -7225,8 +7224,8 @@ manpage(Config) when is_list(Config) -> <<"T = gb_trees:empty(), QH = qlc:q([X || {{X,Y},_} <- gb_table:table(T), - ((X == 1) or (X == 2)) andalso - ((Y == a) or (Y == b) or (Y == c))]), + (X == 1 orelse X == 2) andalso + (Y == a orelse Y == b orelse Y == c)]), L = \"ets:match_spec_run(lists:flatmap(fun(K) -> case gb_trees:lookup(K, @@ -7257,13 +7256,13 @@ manpage(Config) when is_list(Config) -> [2,3,4] = qlc:eval(QH), %% ets(3) - MS = ets:fun2ms(fun({X,Y}) when (X > 1) or (X < 5) -> {Y} end), + MS = ets:fun2ms(fun({X,Y}) when X > 1 orelse X < 5 -> {Y} end), ETs = [ [<<"true = ets:insert(Tab = ets:new(t, []),[{1,a},{2,b},{3,c},{4,d}]), MS = ">>, io_lib:format("~w", [MS]), <<", QH1 = ets:table(Tab, [{traverse, {select, MS}}]), - QH2 = qlc:q([{Y} || {X,Y} <- ets:table(Tab), (X > 1) or (X < 5)]), + QH2 = qlc:q([{Y} || {X,Y} <- ets:table(Tab), X > 1 orelse X < 5]), true = qlc:info(QH1) =:= qlc:info(QH2), true = ets:delete(Tab)">>]], @@ -7276,7 +7275,7 @@ manpage(Config) when is_list(Config) -> MS = ">>, io_lib:format("~w", [MS]), <<", QH1 = dets:table(T, [{traverse, {select, MS}}]), - QH2 = qlc:q([{Y} || {X,Y} <- dets:table(t), (X > 1) or (X < 5)]), + QH2 = qlc:q([{Y} || {X,Y} <- dets:table(t), X > 1 orelse X < 5]), true = qlc:info(QH1) =:= qlc:info(QH2), ok = dets:close(T)">>]], @@ -7677,7 +7676,7 @@ i(H, Option) -> has_format({format,_}) -> true; has_format([E | Es]) -> - has_format(E) or has_format(Es); + has_format(E) orelse has_format(Es); has_format(_) -> false. diff --git a/lib/stdlib/test/run_pcre_tests.erl b/lib/stdlib/test/run_pcre_tests.erl index 570a43f66729..0ad217577cb5 100644 --- a/lib/stdlib/test/run_pcre_tests.erl +++ b/lib/stdlib/test/run_pcre_tests.erl @@ -449,7 +449,7 @@ contains_lang_sens(<<_,R/binary>>) -> interpret_options_x(Options,RE) -> {O,R} = interpret_options(Options), - case (contains_lang_sens(RE) or lists:member(caseless,O)) of + case contains_lang_sens(RE) orelse lists:member(caseless,O) of false -> {[{exec_option,accept_nonascii}|O],R}; true -> @@ -740,7 +740,7 @@ escape2(Any,_) -> Any. -trx(N) when ((N >= $0) and (N =< $9)) -> +trx(N) when N >= $0, N =< $9 -> N - $0; trx($A) -> 10; trx($B) -> 11; @@ -796,10 +796,10 @@ multi_esc(<>,_) multi_esc(<<$x,${,N,O,$},Rest/binary>>,Unicode) - when ((((N >= $0) and (N =< $9)) or ((N >= $A) and (N =< $F)) or - ((N >= $a) and (N =< $f))) and - (((O >= $0) and (O =< $9)) or ((O >= $A) and (O =< $F)) or - ((O >= $a) and (O =< $f)))) -> + when (N >= $0 andalso N =< $9) orelse (N >= $A andalso N =< $F) + orelse (N >= $a andalso N =< $f), + (O >= $0 andalso O =< $9) orelse (O >= $A andalso O =< $F) + orelse (O >= $a andalso O =< $f) -> Cha = (trx(N) bsl 4) bor trx(O), case Unicode of false -> @@ -808,63 +808,63 @@ multi_esc(<<$x,${,N,O,$},Rest/binary>>,Unicode) {int_to_utf8(Cha),Rest} end; multi_esc(<<$x,${,N,O,P,$},Rest/binary>>,_) - when ((((N >= $0) and (N =< $9)) or ((N >= $A) and (N =< $F)) or - ((N >= $a) and (N =< $f))) and - (((O >= $0) and (O =< $9)) or ((O >= $A) and (O =< $F)) or - ((O >= $a) and (O =< $f)))and - (((P >= $0) and (P =< $9)) or ((P >= $A) and (P =< $F)) or - ((P >= $a) and (P =< $f)))) -> + when (N >= $0 andalso N =< $9) orelse (N >= $A andalso N =< $F) + orelse (N >= $a andalso N =< $f), + (O >= $0 andalso O =< $9) orelse (O >= $A andalso O =< $F) + orelse (O >= $a andalso O =< $f), + (P >= $0 andalso P =< $9) orelse (P >= $A andalso P =< $F) + orelse (P >= $a andalso P =< $f) -> Cha = (trx(N) bsl 8) bor (trx(O) bsl 4) bor trx(P), {int_to_utf8(Cha),Rest}; multi_esc(<<$x,${,N,O,P,Q,$},Rest/binary>>,_) - when ((((N >= $0) and (N =< $9)) or ((N >= $A) and (N =< $F)) or - ((N >= $a) and (N =< $f))) and - (((O >= $0) and (O =< $9)) or ((O >= $A) and (O =< $F)) or - ((O >= $a) and (O =< $f))) and - (((P >= $0) and (P =< $9)) or ((P >= $A) and (P =< $F)) or - ((P >= $a) and (P =< $f))) and - (((Q >= $0) and (Q =< $9)) or ((Q >= $A) and (Q =< $F)) or - ((Q >= $a) and (Q =< $f)))) -> + when (N >= $0 andalso N =< $9) orelse (N >= $A andalso N =< $F) + orelse (N >= $a andalso N =< $f), + (O >= $0 andalso O =< $9) orelse (O >= $A andalso O =< $F) + orelse (O >= $a andalso O =< $f), + (P >= $0 andalso P =< $9) orelse (P >= $A andalso P =< $F) + orelse (P >= $a andalso P =< $f), + (Q >= $0 andalso Q =< $9) orelse (Q >= $A andalso Q =< $F) + orelse (Q >= $a andalso Q =< $f) -> Cha = (trx(N) bsl 12) bor (trx(O) bsl 8) bor (trx(P) bsl 4) bor trx(Q), {int_to_utf8(Cha),Rest}; multi_esc(<<$x,${,N,O,P,Q,R,$},Rest/binary>>,_) - when ((((N >= $0) and (N =< $9)) or ((N >= $A) and (N =< $F)) or - ((N >= $a) and (N =< $f))) and - (((O >= $0) and (O =< $9)) or ((O >= $A) and (O =< $F)) or - ((O >= $a) and (O =< $f))) and - (((P >= $0) and (P =< $9)) or ((P >= $A) and (P =< $F)) or - ((P >= $a) and (P =< $f))) and - (((Q >= $0) and (Q =< $9)) or ((Q >= $A) and (Q =< $F)) or - ((Q >= $a) and (Q =< $f))) and - (((R >= $0) and (R =< $9)) or ((R >= $A) and (R =< $F)) or - ((R >= $a) and (R =< $f)))) -> + when (N >= $0 andalso N =< $9) orelse (N >= $A andalso N =< $F) + orelse (N >= $a andalso N =< $f), + (O >= $0 andalso O =< $9) orelse (O >= $A andalso O =< $F) + orelse (O >= $a andalso O =< $f), + (P >= $0 andalso P =< $9) orelse (P >= $A andalso P =< $F) + orelse (P >= $a andalso P =< $f), + (Q >= $0 andalso Q =< $9) orelse (Q >= $A andalso Q =< $F) + orelse (Q >= $a andalso Q =< $f), + (R >= $0 andalso R =< $9) orelse (R >= $A andalso R =< $F) + orelse (R >= $a andalso R =< $f) -> Cha = (trx(N) bsl 16) bor (trx(O) bsl 12) bor (trx(P) bsl 8) bor (trx(Q) bsl 4) bor trx(R), {int_to_utf8(Cha),Rest}; multi_esc(<<$x,${,N,O,P,Q,R,S,$},Rest/binary>>,_) - when ((((N >= $0) and (N =< $9)) or ((N >= $A) and (N =< $F)) or - ((N >= $a) and (N =< $f))) and - (((O >= $0) and (O =< $9)) or ((O >= $A) and (O =< $F)) or - ((O >= $a) and (O =< $f))) and - (((P >= $0) and (P =< $9)) or ((P >= $A) and (P =< $F)) or - ((P >= $a) and (P =< $f))) and - (((Q >= $0) and (Q =< $9)) or ((Q >= $A) and (Q =< $F)) or - ((Q >= $a) and (Q =< $f))) and - (((R >= $0) and (R =< $9)) or ((R >= $A) and (R =< $F)) or - ((R >= $a) and (R =< $f))) and - (((S >= $0) and (S =< $9)) or ((S >= $A) and (S =< $F)) or - ((S >= $a) and (S =< $f)))) -> + when (N >= $0 andalso N =< $9) orelse (N >= $A andalso N =< $F) + orelse (N >= $a andalso N =< $f), + (O >= $0 andalso O =< $9) orelse (O >= $A andalso O =< $F) + orelse (O >= $a andalso O =< $f), + (P >= $0 andalso P =< $9) orelse (P >= $A andalso P =< $F) + orelse (P >= $a andalso P =< $f), + (Q >= $0 andalso Q =< $9) orelse (Q >= $A andalso Q =< $F) + orelse (Q >= $a andalso Q =< $f), + (R >= $0 andalso R =< $9) orelse (R >= $A andalso R =< $F) + orelse (R >= $a andalso R =< $f), + (S >= $0 andalso S =< $9) orelse (S >= $A andalso S =< $F) + orelse (S >= $a andalso S =< $f) -> Cha = (trx(N) bsl 20) bor (trx(O) bsl 16) bor (trx(P) bsl 12) bor (trx(Q) bsl 8) bor (trx(R) bsl 4) bor trx(S), {int_to_utf8(Cha),Rest}; multi_esc(<<$x,N,O,Rest/binary>>,_) - when ((((N >= $0) and (N =< $9)) or ((N >= $A) and (N =< $F)) or - ((N >= $a) and (N =< $f))) and - (((O >= $0) and (O =< $9)) or ((O >= $A) and (O =< $F)) or - ((O >= $a) and (O =< $f)))) -> + when (N >= $0 andalso N =< $9) orelse (N >= $A andalso N =< $F) + orelse (N >= $a andalso N =< $f), + (O >= $0 andalso O =< $9) orelse (O >= $A andalso O =< $F) + orelse (O >= $a andalso O =< $f) -> Cha = (trx(N) bsl 4) bor trx(O), {<>,Rest}; multi_esc(<<$x,N,Rest/binary>>,_) - when (((N >= $0) and (N =< $9)) or ((N >= $A) and (N =< $F)) or - ((N >= $a) and (N =< $f))) -> + when (N >= $0 andalso N =< $9) orelse (N >= $A andalso N =< $F) orelse + (N >= $a andalso N =< $f) -> Cha = trx(N), {<>,Rest}; multi_esc(_,_) -> diff --git a/lib/stdlib/test/select_SUITE.erl b/lib/stdlib/test/select_SUITE.erl index 22b6d37e5d17..da77299a46f2 100644 --- a/lib/stdlib/test/select_SUITE.erl +++ b/lib/stdlib/test/select_SUITE.erl @@ -624,8 +624,8 @@ multi_mixed_key(Tabs,Type) -> [ {A,F} | Acc]; Else -> - case FunE(Else) or - FunG(Else) or + case FunE(Else) orelse + FunG(Else) orelse FunJ(Else) of true -> [ {A,F} | diff --git a/lib/stdlib/test/supervisor_SUITE.erl b/lib/stdlib/test/supervisor_SUITE.erl index 79ca0418b4b0..5a35555ab1bb 100644 --- a/lib/stdlib/test/supervisor_SUITE.erl +++ b/lib/stdlib/test/supervisor_SUITE.erl @@ -2082,7 +2082,7 @@ dont_save_start_parameters_for_temporary_children(simple_one_for_one = Type) -> Size2 = erts_debug:flat_size(sys:get_status(Sup2)), Size3 = erts_debug:flat_size(sys:get_status(Sup3)), - true = (Size3 < Size1) and (Size3 < Size2), + true = Size3 < Size1 andalso Size3 < Size2, terminate(Sup1, shutdown), terminate(Sup2, shutdown), @@ -2110,7 +2110,7 @@ dont_save_start_parameters_for_temporary_children(Type) -> Size2 = erts_debug:flat_size(sys:get_status(Sup2)), Size3 = erts_debug:flat_size(sys:get_status(Sup3)), - true = (Size3 < Size1) and (Size3 < Size2), + true = Size3 < Size1 andalso Size3 < Size2, terminate(Sup1, shutdown), terminate(Sup2, shutdown),