guix package: Always upgrade packages that have propagated inputs.

[jackhill/guix/guix.git] / tests / profiles.scm

diff --git a/tests/profiles.scm b/tests/profiles.scm
index d0b1e14..94759c0 100644 (file)
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -50,6 +50,12 @@
     (run-with-store %store exp
                     #:guile-for-build (%guile-for-build))))
 
+(define-syntax-rule (test-equalm name value exp)
+  (test-equal name
+    value
+    (run-with-store %store exp
+                    #:guile-for-build (%guile-for-build))))
+
 ;; Example manifest entries.
 
 (define guile-1.8.8
@@ -282,6 +288,52 @@
            (manifest-entry-search-paths
             (package->manifest-entry mpl)))))
 
+(test-equal "packages->manifest, propagated inputs"
+  (map (match-lambda
+         ((label package)
+          (list (package-name package) (package-version package)
+                package)))
+       (package-propagated-inputs packages:guile-2.2))
+  (map (lambda (entry)
+         (list (manifest-entry-name entry)
+               (manifest-entry-version entry)
+               (manifest-entry-item entry)))
+       (manifest-entry-dependencies
+        (package->manifest-entry packages:guile-2.2))))
+
+(test-assert "manifest-entry-parent"
+  (let ((entry (package->manifest-entry packages:guile-2.2)))
+    (match (manifest-entry-dependencies entry)
+      ((dependencies ..1)
+       (and (every (lambda (parent)
+                     (eq? entry (force parent)))
+                   (map manifest-entry-parent dependencies))
+            (not (force (manifest-entry-parent entry))))))))
+
+(test-assertm "read-manifest"
+  (mlet* %store-monad ((manifest -> (packages->manifest
+                                     (list (package
+                                             (inherit %bootstrap-guile)
+                                             (native-search-paths
+                                              (package-native-search-paths
+                                               packages:guile-2.0))))))
+                       (drv (profile-derivation manifest
+                                                #:hooks '()
+                                                #:locales? #f))
+                       (out -> (derivation->output-path drv)))
+    (define (entry->sexp entry)
+      (list (manifest-entry-name entry)
+            (manifest-entry-version entry)
+            (manifest-entry-search-paths entry)
+            (manifest-entry-dependencies entry)
+            (force (manifest-entry-parent entry))))
+
+    (mbegin %store-monad
+      (built-derivations (list drv))
+      (let ((manifest2 (profile-manifest out)))
+        (return (equal? (map entry->sexp (manifest-entries manifest))
+                        (map entry->sexp (manifest-entries manifest2))))))))
+
 (test-assertm "etc/profile"
   ;; Make sure we get an 'etc/profile' file that at least defines $PATH.
   (mlet* %store-monad
@@ -366,6 +418,29 @@
                                get-string-all)
                              "foo!"))))))
 
+(test-equalm "union vs. dangling symlink"        ;<https://bugs.gnu.org/26949>
+  "does-not-exist"
+  (mlet* %store-monad
+      ((thing1 ->  (dummy-package "dummy"
+                     (build-system trivial-build-system)
+                     (arguments
+                      `(#:guile ,%bootstrap-guile
+                        #:builder
+                        (let ((out (assoc-ref %outputs "out")))
+                          (mkdir out)
+                          (symlink "does-not-exist"
+                                   (string-append out "/dangling"))
+                          #t)))))
+       (thing2 ->  (package (inherit thing1) (name "dummy2")))
+       (drv        (profile-derivation (packages->manifest
+                                        (list thing1 thing2))
+                                       #:hooks '()
+                                       #:locales? #f))
+       (profile -> (derivation->output-path drv)))
+    (mbegin %store-monad
+      (built-derivations (list drv))
+      (return (readlink (readlink (string-append profile "/dangling")))))))
+
 (test-end "profiles")
 
 ;;; Local Variables: