From: timor <timor.dd@googlemail.com>
Date: Thu, 22 Jul 2021 15:51:25 +0000 (+0200)
Subject: assocs.extras: Fix error with assoc-collapse with f as first element
X-Git-Tag: 0.99~2259
X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=32827392983e9b040216a81f9a41d2292d9327b3

assocs.extras: Fix error with assoc-collapse with f as first element

Since `assoc-collapse` uses a clone of the first assoc in the input sequence as
basis for the resulting assoc, this was failing when the first element was `f`.
Change behavior to return a hashtable instead, since this is the
default behavior for `f new-assoc` as well.
---

diff --git a/extra/assocs/extras/extras-tests.factor b/extra/assocs/extras/extras-tests.factor
index e14ef76a94..276005980c 100644
--- a/extra/assocs/extras/extras-tests.factor
+++ b/extra/assocs/extras/extras-tests.factor
@@ -136,3 +136,12 @@ USING: arrays assocs.extras kernel math math.order sequences tools.test ;
     H{ { 3 30 } { 4 40 } } 3array
     [ min ] assoc-collapse
 ] unit-test
+
+{
+    H{ { 2 22 } { 3 30 } { 4 40 } }
+} [
+    f
+    H{ { 2 22 } { 3 33 } }
+    H{ { 3 30 } { 4 40 } } 3array
+    [ min ] assoc-collapse
+] unit-test
diff --git a/extra/assocs/extras/extras.factor b/extra/assocs/extras/extras.factor
index b13bd21f18..44b0768179 100644
--- a/extra/assocs/extras/extras.factor
+++ b/extra/assocs/extras/extras.factor
@@ -80,7 +80,7 @@ IN: assocs.extras
 : assoc-collapse ( seq quot: ( value1 value2 -- new-value ) -- assoc )
     over empty?
     [ 2drop f ]
-    [ [ unclip-slice clone ] [ [ assoc-merge! ] curry ] bi* reduce ] if ; inline
+    [ [ unclip-slice H{ } or clone ] [ [ assoc-merge! ] curry ] bi* reduce ] if ; inline
 
 GENERIC: delete-value-at ( value assoc -- )