PR#7403: fix a bug in Set.map (new in 4.04.0)
(cherry-pick from the 4.04 branch)master
parent
bc81c313b0
commit
8972bd0693
8
Changes
8
Changes
|
@ -92,6 +92,14 @@ Next version (4.05.0):
|
|||
to a string array of new arguments
|
||||
(Bernhard Schommer)
|
||||
|
||||
Next minor version (4.04.1):
|
||||
----------------------------
|
||||
|
||||
### Standard library:
|
||||
|
||||
- PR#7403, GPR#894: fix a bug in Set.map as introduced in 4.04.0
|
||||
(Gabriel Scherer, report by Thomas Leonard)
|
||||
|
||||
OCaml 4.04.0 (4 Nov 2016):
|
||||
--------------------------
|
||||
|
||||
|
|
|
@ -398,6 +398,15 @@ module Make(Ord: OrderedType) =
|
|||
if c = 0 then Some v
|
||||
else find_opt x (if c < 0 then l else r)
|
||||
|
||||
let try_join l v r =
|
||||
(* [join l v r] can only be called when (elements of l < v <
|
||||
elements of r); use [try_join l v r] when this property may
|
||||
not hold, but you hope it does hold in the common case *)
|
||||
if (l = Empty || Ord.compare (max_elt l) v < 0)
|
||||
&& (r = Empty || Ord.compare v (min_elt r) < 0)
|
||||
then join l v r
|
||||
else union l (add v r)
|
||||
|
||||
let rec map f = function
|
||||
| Empty -> Empty
|
||||
| Node (l, v, r, _) as t ->
|
||||
|
@ -406,12 +415,7 @@ module Make(Ord: OrderedType) =
|
|||
let v' = f v in
|
||||
let r' = map f r in
|
||||
if l == l' && v == v' && r == r' then t
|
||||
else begin
|
||||
if (l' = Empty || Ord.compare (max_elt l') v < 0)
|
||||
&& (r' = Empty || Ord.compare v (min_elt r') < 0)
|
||||
then join l' v' r'
|
||||
else union l' (add v' r')
|
||||
end
|
||||
else try_join l' v' r'
|
||||
|
||||
let of_sorted_list l =
|
||||
let rec sub n l =
|
||||
|
|
|
@ -167,3 +167,21 @@ let () =
|
|||
for i = 1 to 10 do s1 := S.add i !s1 done;
|
||||
let s2 = S.filter (fun e -> e >= 0) !s1 in
|
||||
assert (s2 == !s1)
|
||||
|
||||
let valid_structure s =
|
||||
(* this test should return 'true' for all set,
|
||||
but it can detect sets that are ill-structured,
|
||||
for example incorrectly ordered, as the S.mem
|
||||
function will make assumptions about the set ordering.
|
||||
|
||||
(This trick was used to exhibit the bug in PR#7403)
|
||||
*)
|
||||
List.for_all (fun n -> S.mem n s) (S.elements s)
|
||||
|
||||
let () =
|
||||
(* PR#7403: map buggily orders elements according to the input
|
||||
set order, not the output set order. Mapping functions that
|
||||
change the value ordering thus break the set structure. *)
|
||||
let test = S.of_list [1; 3; 5] in
|
||||
let f = function 3 -> 8 | n -> n in
|
||||
assert (valid_structure (S.map f test))
|
||||
|
|
Loading…
Reference in New Issue