From b18962b0ff7e7009c9350ebca87c8a1b71bf6dfd Mon Sep 17 00:00:00 2001 From: Moritz Heidkamp Date: Mon, 13 Apr 2015 23:18:12 +0200 Subject: [PATCH] Fix #1185: Normalize DAG passed to topological-sort so that edges of duplicate nodes are merged --- data-structures.scm | 13 ++++++++++++- tests/data-structures-tests.scm | 2 +- 2 files changed, 13 insertions(+), 2 deletions(-) diff --git a/data-structures.scm b/data-structures.scm index 511a3c1..a424c8e 100644 --- a/data-structures.scm +++ b/data-structures.scm @@ -753,7 +753,18 @@ #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 51c25a9..461b1cf 100644 --- a/tests/data-structures-tests.scm +++ b/tests/data-structures-tests.scm @@ -61,7 +61,7 @@ (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? '(c d a b) (topological-sort '((c d) (a b)) eq?))) (assert-error (topological-sort '((a b) (b a)) eq?)) ;; Queues. -- 2.3.5