File 0161-compiler-Fix-some-vestigial-0.0-0.0-issues.patch of Package erlang
From 34ef50ce7052a9e4fa27744046c4057ba82b13ef Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?John=20H=C3=B6gberg?= <john@erlang.org>
Date: Thu, 23 Nov 2023 17:38:08 +0100
Subject: [PATCH] compiler: Fix some vestigial +0.0/-0.0 issues
---
lib/compiler/src/beam_types.erl | 112 ++++++++++++++++++--------
lib/compiler/test/beam_type_SUITE.erl | 46 ++++++++++-
2 files changed, 121 insertions(+), 37 deletions(-)
diff --git a/lib/compiler/src/beam_types.erl b/lib/compiler/src/beam_types.erl
index 3fc2476898..b81bbc0616 100644
--- a/lib/compiler/src/beam_types.erl
+++ b/lib/compiler/src/beam_types.erl
@@ -45,7 +45,6 @@
make_boolean/0,
make_cons/2,
make_float/1,
- make_float/2,
make_integer/1,
make_integer/2]).
@@ -169,10 +168,16 @@ mts_records([{Key, A} | RsA], [{Key, B} | RsB], Acc) ->
none -> mts_records(RsA, RsB, Acc);
T -> mts_records(RsA, RsB, [{Key, T} | Acc])
end;
-mts_records([{KeyA, _} | _ ]=RsA, [{KeyB, _} | RsB], Acc) when KeyA > KeyB ->
- mts_records(RsA, RsB, Acc);
-mts_records([{KeyA, _} | RsA], [{KeyB, _} | _] = RsB, Acc) when KeyA < KeyB ->
- mts_records(RsA, RsB, Acc);
+mts_records([{KeyA, _} | _]=RsA, [{KeyB, _} | _]=RsB, Acc) ->
+ %% We must use total ordering rather than plain '<' as -0.0 differs from
+ %% +0.0
+ case total_compare(KeyA, KeyB, fun erlang:'<'/2) of
+ true ->
+ mts_records(tl(RsA), RsB, Acc);
+ false ->
+ true = KeyA =/= KeyB, %Assertion.
+ mts_records(RsA, tl(RsB), Acc)
+ end;
mts_records(_RsA, [], [_|_]=Acc) ->
reverse(Acc);
mts_records([], _RsB, [_|_]=Acc) ->
@@ -320,10 +325,16 @@ jts_records(RsA, RsB, N, Acc) when N > ?TUPLE_SET_LIMIT ->
#t_tuple{} = normalize_tuple_set(Acc, B);
jts_records([{Key, A} | RsA], [{Key, B} | RsB], N, Acc) ->
jts_records(RsA, RsB, N + 1, [{Key, lub(A, B)} | Acc]);
-jts_records([{KeyA, _} | _]=RsA, [{KeyB, B} | RsB], N, Acc) when KeyA > KeyB ->
- jts_records(RsA, RsB, N + 1, [{KeyB, B} | Acc]);
-jts_records([{KeyA, A} | RsA], [{KeyB, _} | _] = RsB, N, Acc) when KeyA < KeyB ->
- jts_records(RsA, RsB, N + 1, [{KeyA, A} | Acc]);
+jts_records([{KeyA, A} | _]=RsA, [{KeyB, B} | _]=RsB, N, Acc) ->
+ %% We must use total ordering rather than plain '<' as -0.0 differs from
+ %% +0.0
+ case total_compare(KeyA, KeyB, fun erlang:'<'/2) of
+ true ->
+ jts_records(tl(RsA), RsB, N + 1, [{KeyA, A} | Acc]);
+ false ->
+ true = KeyA =/= KeyB, %Assertion.
+ jts_records(RsA, tl(RsB), N + 1, [{KeyB, B} | Acc])
+ end;
jts_records([{KeyA, A} | RsA], [], N, Acc) ->
jts_records(RsA, [], N + 1, [{KeyA, A} | Acc]);
jts_records([], [{KeyB, B} | RsB], N, Acc) ->
@@ -479,8 +490,7 @@ is_bs_matchable_type(Type) ->
Result :: {ok, term()} | error.
get_singleton_value(#t_atom{elements=[Atom]}) ->
{ok, Atom};
-get_singleton_value(#t_float{elements={Float,Float}}) when Float /= 0 ->
- %% 0.0 is not actually a singleton as it has two encodings: 0.0 and -0.0
+get_singleton_value(#t_float{elements={Float,Float}}) ->
{ok, Float};
get_singleton_value(#t_integer{elements={Int,Int}}) ->
{ok, Int};
@@ -697,11 +707,7 @@ make_cons(Head0, Tail) ->
-spec make_float(float()) -> type().
make_float(Float) when is_float(Float) ->
- make_float(Float, Float).
-
--spec make_float(float(), float()) -> type().
-make_float(Min, Max) when is_float(Min), is_float(Max), Min =< Max ->
- #t_float{elements={Min, Max}}.
+ #t_float{elements={Float,Float}}.
-spec make_integer(integer()) -> type().
make_integer(Int) when is_integer(Int) ->
@@ -882,7 +888,7 @@ glb(#t_integer{elements=R1}, #t_integer{elements=R2}) ->
glb(#t_integer{elements=R1}, #t_number{elements=R2}) ->
integer_from_range(glb_ranges(R1, R2));
glb(#t_float{elements=R1}, #t_number{elements=R2}) ->
- float_from_range(glb_ranges(R1, R2));
+ float_from_range(glb_ranges(R1, number_to_float_range(R2)));
glb(#t_list{type=TypeA,terminator=TermA},
#t_list{type=TypeB,terminator=TermB}) ->
%% A list is a union of `[type() | _]` and `[]`, so we're left with
@@ -903,7 +909,7 @@ glb(#t_number{elements=R1}, #t_number{elements=R2}) ->
glb(#t_number{elements=R1}, #t_integer{elements=R2}) ->
integer_from_range(glb_ranges(R1, R2));
glb(#t_number{elements=R1}, #t_float{elements=R2}) ->
- float_from_range(glb_ranges(R1, R2));
+ float_from_range(glb_ranges(number_to_float_range(R1), R2));
glb(#t_map{super_key=SKeyA,super_value=SValueA},
#t_map{super_key=SKeyB,super_value=SValueB}) ->
%% Note the use of meet/2; elements don't need to be normal types.
@@ -1132,6 +1138,14 @@ lub_ranges({MinA,MaxA}, {MinB,MaxB}) ->
lub_ranges(_, _) ->
any.
+%% Expands integer 0 to `-0.0 .. +0.0`
+number_to_float_range({Min, 0}) ->
+ number_to_float_range({Min, +0.0});
+number_to_float_range({0, Max}) ->
+ number_to_float_range({-0.0, Max});
+number_to_float_range(Other) ->
+ Other.
+
lub_bs_matchable(UnitA, UnitB) ->
#t_bs_matchable{tail_unit=gcd(UnitA, UnitB)}.
@@ -1179,12 +1193,13 @@ float_from_range(none) ->
none;
float_from_range(any) ->
#t_float{};
-float_from_range({Min0,Max0}) ->
- case {safe_float(Min0),safe_float(Max0)} of
+float_from_range({Min0, Max0}) ->
+ true = inf_le(Min0, Max0), %Assertion.
+ case {safe_float(Min0), safe_float(Max0)} of
{'-inf','+inf'} ->
#t_float{};
- {Min,Max} ->
- #t_float{elements={Min,Max}}
+ {Min, Max} ->
+ #t_float{elements={Min, Max}}
end.
safe_float(N) when is_number(N) ->
@@ -1218,21 +1233,48 @@ number_from_range(N) ->
none
end.
-inf_le('-inf', _) -> true;
-inf_le(A, B) -> A =< B.
-
-inf_ge(_, '-inf') -> true;
-inf_ge('-inf', _) -> false;
-inf_ge(A, B) -> A >= B.
+inf_le('-inf', _) ->
+ true;
+inf_le(A, B) when is_float(A), is_float(B) ->
+ %% When float ranges are compared to float ranges, the total ordering
+ %% function must be used to preserve `-0.0 =/= +0.0`.
+ total_compare(A, B, fun erlang:'=<'/2);
+inf_le(A, B) ->
+ A =< B.
+
+inf_ge(_, '-inf') ->
+ true;
+inf_ge('-inf', _) ->
+ false;
+inf_ge(A, B) when is_float(A), is_float(B) ->
+ total_compare(A, B, fun erlang:'>='/2);
+inf_ge(A, B) ->
+ A >= B.
+
+inf_min(A, B) when A =:= '-inf'; B =:= '-inf' ->
+ '-inf';
+inf_min(A, B) when is_float(A), is_float(B) ->
+ case total_compare(A, B, fun erlang:'=<'/2) of
+ true -> A;
+ false -> B
+ end;
+inf_min(A, B) ->
+ min(A, B).
-inf_min(A, B) when A =:= '-inf'; B =:= '-inf' -> '-inf';
-inf_min(A, B) when A =< B -> A;
-inf_min(A, B) when A > B -> B.
+inf_max('-inf', B) ->
+ B;
+inf_max(A, '-inf') ->
+ A;
+inf_max(A, B) when is_float(A), is_float(B) ->
+ case total_compare(A, B, fun erlang:'>='/2) of
+ true -> A;
+ false -> B
+ end;
+inf_max(A, B) ->
+ max(A, B).
-inf_max('-inf', B) -> B;
-inf_max(A, '-inf') -> A;
-inf_max(A, B) when A >= B -> A;
-inf_max(A, B) when A < B -> B.
+total_compare(A, B, Order) ->
+ Order(erts_internal:cmp_term(A, B), 0).
%%
diff --git a/lib/compiler/test/beam_type_SUITE.erl b/lib/compiler/test/beam_type_SUITE.erl
index 49b5cb6e74..69bfcbe7b4 100644
--- a/lib/compiler/test/beam_type_SUITE.erl
+++ b/lib/compiler/test/beam_type_SUITE.erl
@@ -31,7 +31,7 @@
switch_fail_inference/1,failures/1,
cover_maps_functions/1,min_max_mixed_types/1,
not_equal/1,infer_relops/1,binary_unit/1,premature_concretization/1,
- funs/1,will_succeed/1]).
+ funs/1,will_succeed/1,float_confusion/1]).
%% Force id/1 to return 'any'.
-export([id/1]).
@@ -76,7 +76,8 @@ groups() ->
binary_unit,
premature_concretization,
funs,
- will_succeed
+ will_succeed,
+ float_confusion
]}].
init_per_suite(Config) ->
@@ -1505,6 +1506,47 @@ will_succeed_1(_V0, _V1)
will_succeed_1(_, _) ->
b.
+%% GH-7901: Range operations did not honor the total order of floats.
+float_confusion(_Config) ->
+ ok = float_confusion_1(catch (true = ok), -0.0),
+ ok = float_confusion_1(ok, 0.0),
+ {'EXIT', _} = catch float_confusion_2(),
+ {'EXIT', _} = catch float_confusion_3(id(0.0)),
+ ok = float_confusion_4(id(1)),
+ {'EXIT', _} = catch float_confusion_5(),
+ ok.
+
+float_confusion_1(_, _) ->
+ ok.
+
+float_confusion_2() ->
+ [ok || _ := _ <- ok,
+ float_confusion_crash(catch float_confusion_crash(ok, -1), -0.0)].
+
+float_confusion_crash(_, 18446744073709551615) ->
+ ok.
+
+float_confusion_3(V) ->
+ -0.0 = abs(V),
+ ok.
+
+float_confusion_4(V) when -0.0 < floor(V band 1) ->
+ ok.
+
+float_confusion_5() ->
+ -0.0 =
+ case
+ fun() ->
+ ok
+ end
+ of
+ _V2 when (_V2 > ok) ->
+ 2147483647.0;
+ _ ->
+ -2147483648
+ end * 0,
+ ok.
+
%%%
%%% Common utilities.
%%%
--
2.35.3
