~ chicken-core (chicken-5) b175ce65fe17c0887ed89f070dc4c16ef95d51f9
commit b175ce65fe17c0887ed89f070dc4c16ef95d51f9
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Sun Apr 11 21:24:36 2021 +0200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Sun Apr 11 21:24:36 2021 +0200
applied patch by Moritz Heidkamp for fixing #1185: normalize dag before sorting topologically
Signed-off-by: felix <felix@call-with-current-continuation.org>
diff --git a/data-structures.scm b/data-structures.scm
index 09f11760..44dc6827 100644
--- a/data-structures.scm
+++ b/data-structures.scm
@@ -543,7 +543,16 @@
#f
(cons edge path)
state))))))))
- (let loop ((dag dag)
+ (define normalized-dag
+ (foldl (lambda (result node)
+ (alist-update! (car node)
+ (append (cdr node)
+ (or (alist-ref (car node) dag pred) '()))
+ result
+ pred))
+ '()
+ dag))
+ (let loop ((dag normalized-dag)
(state (cons (list) (list))))
(if (null? dag)
(cdr state)
diff --git a/tests/data-structures-tests.scm b/tests/data-structures-tests.scm
index b1851857..1d7820df 100644
--- a/tests/data-structures-tests.scm
+++ b/tests/data-structures-tests.scm
@@ -79,5 +79,19 @@
(assert (equal? '() (topological-sort '() eq?)))
(assert (equal? '(a b c d) (topological-sort '((a b) (b c) (c d)) eq?)))
-(assert (equal? '(c d a b) (topological-sort '((a b) (c d)) eq?)))
+(assert (equal? '(a b c d) (topological-sort '((a b) (c d)) eq?)))
(assert-error (topological-sort '((a b) (b a)) eq?))
+(assert
+ (equal?
+ (topological-sort
+ '((i am)
+ (not trying)
+ (confuse the)
+ (am trying)
+ (trying to)
+ (am not)
+ (trying the)
+ (to confuse)
+ (the issue))
+ eq?)
+ '(i am not trying to confuse the issue)))
Trap