diff options
| author | Liliana Marie Prikler <liliana.prikler@gmail.com> | 2022-01-24 19:15:44 +0100 |
|---|---|---|
| committer | Liliana Marie Prikler <liliana.prikler@gmail.com> | 2022-02-05 08:02:30 +0100 |
| commit | 45082b9a8c12af285f4386538fc7acc4668cb11c (patch) | |
| tree | 6f5c266feddc2259e836208c1f00a59656d17709 | |
| parent | 10b901a4376f98de58272cd28cdaf82979038053 (diff) | |
| download | guix-patches-45082b9a8c12af285f4386538fc7acc4668cb11c.tar guix-patches-45082b9a8c12af285f4386538fc7acc4668cb11c.tar.gz | |
tests: Assert that cyclic graphs can be produced.
* tests/graph.scm ("package DAG, oops it was a cycle"): New test.
| -rw-r--r-- | tests/graph.scm | 28 |
1 files changed, 28 insertions, 0 deletions
diff --git a/tests/graph.scm b/tests/graph.scm index fadac265f9..baa08a6be2 100644 --- a/tests/graph.scm +++ b/tests/graph.scm @@ -36,6 +36,7 @@ #:use-module (gnu packages libunistring) #:use-module (gnu packages bootstrap) #:use-module (ice-9 match) + #:use-module (ice-9 sandbox) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) @@ -113,6 +114,33 @@ edges." (list p4 p4) (list p2 p3)))))))) +(test-assert "package DAG, oops it was a cycle" + (let-values (((backend nodes+edges) (make-recording-backend))) + (letrec ((p1 (dummy-package "p1" (inputs `(("p3" ,p3))))) + (p2 (dummy-package "p2" (inputs `(("p1" ,p1))))) + (p3 (dummy-package "p3" (inputs `(("p2" ,p2) ("p1", p1)))))) + (call-with-time-limit + 600 ;; If ever this test should fail, we still want it to terminate + (lambda () + (run-with-store %store + (export-graph (list p3) 'port + #:node-type %package-node-type + #:backend backend))) + (lambda () + (run-with-store %store + (export-graph + (list (dummy-package "timeout-reached")) + 'port + #:node-type %package-node-type + #:backend backend)))) + ;; We should see nothing more than these 3 packages. + (let-values (((nodes edges) (nodes+edges))) + (and (equal? nodes (map package->tuple (list p3 p2 p1))) + (equal? edges + (map edge->tuple + (list p3 p3 p2 p1) + (list p2 p1 p1 p3)))))))) + (test-assert "reverse package DAG" (let-values (((backend nodes+edges) (make-recording-backend))) (run-with-store %store |