Merge branch 'staging' into core-updates

3 files changed, 107 insertions, 11 deletions

diff --git a/tests/derivations.scm b/tests/derivations.scm
index 25ba4c9fa0..b0175d9fc5 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -815,20 +815,17 @@
     (null? (derivation-prerequisites-to-build %store drv))))
 
 (test-assert "derivation-prerequisites-to-build when outputs already present"
-  (let* ((builder    '(begin (mkdir %output) #t))
+  (let* ((builder    `(begin ,(random-text) (mkdir %output) #t))
          (input-drv  (build-expression->derivation %store "input" builder))
-         (input-path (derivation-output-path
-                      (assoc-ref (derivation-outputs input-drv)
-                                 "out")))
+         (input-path (derivation->output-path input-drv))
          (drv        (build-expression->derivation %store "something" builder
                                                    #:inputs
                                                    `(("i" ,input-drv))))
          (output     (derivation->output-path drv)))
-    ;; Make sure these things are not already built.
-    (when (valid-path? %store input-path)
-      (delete-paths %store (list input-path)))
-    (when (valid-path? %store output)
-      (delete-paths %store (list output)))
+    ;; Assume these things are not already built.
+    (when (or (valid-path? %store input-path)
+              (valid-path? %store output))
+      (error "things already built" input-drv))
 
     (and (equal? (map derivation-input-path
                       (derivation-prerequisites-to-build %store drv))
diff --git a/tests/hackage.scm b/tests/hackage.scm
index 38a5825af7..77e333cbfc 100644
--- a/tests/hackage.scm
+++ b/tests/hackage.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
+;;; Copyright © 2019 Robert Vollmert <rob@vllmrt.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -236,7 +237,7 @@ library
 (test-assert "hackage->guix-package test 6"
   (eval-test-with-cabal test-cabal-6 match-ghc-foo-6))
 
-;; Check multi-line layouted description
+;; Check multi-line layouted description.
 (define test-cabal-multiline-layout
   "name: foo
 version: 1.0.0
@@ -254,7 +255,7 @@ executable cabal
 (test-assert "hackage->guix-package test multiline desc (layout)"
   (eval-test-with-cabal test-cabal-multiline-layout match-ghc-foo))
 
-;; Check multi-line braced description
+;; Check multi-line braced description.
 (define test-cabal-multiline-braced
   "name: foo
 version: 1.0.0
@@ -274,6 +275,98 @@ executable cabal
 (test-assert "hackage->guix-package test multiline desc (braced)"
   (eval-test-with-cabal test-cabal-multiline-braced match-ghc-foo))
 
+;; Check mixed layout. Compare e.g. warp.
+(define test-cabal-mixed-layout
+  "name: foo
+version: 1.0.0
+homepage: http://test.org
+synopsis: synopsis
+description: description
+license: BSD3
+executable cabal
+    build-depends:
+      HTTP       >= 4000.2.5 && < 4000.3,
+      mtl        >= 2.0      && < 3
+  ghc-options: -Wall
+")
+
+;; Fails: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=35743
+(test-expect-fail 1)
+(test-assert "hackage->guix-package test mixed layout"
+  (eval-test-with-cabal test-cabal-mixed-layout match-ghc-foo))
+
+;; Check flag executable. Compare e.g. darcs.
+(define test-cabal-flag-executable
+  "name: foo
+version: 1.0.0
+homepage: http://test.org
+synopsis: synopsis
+description: description
+license: BSD3
+flag executable
+  description: Build executable
+  default:     True
+executable cabal
+  if !flag(executable)
+    buildable: False
+  else
+    buildable: True
+
+  build-depends:
+    HTTP       >= 4000.2.5 && < 4000.3,
+    mtl        >= 2.0      && < 3
+")
+
+;; Fails: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=25138
+(test-expect-fail 1)
+(test-assert "hackage->guix-package test flag executable"
+  (eval-test-with-cabal test-cabal-flag-executable match-ghc-foo))
+
+;; Check Hackage Cabal revisions.
+(define test-cabal-revision
+  "name: foo
+version: 1.0.0
+x-revision: 2
+homepage: http://test.org
+synopsis: synopsis
+description: description
+license: BSD3
+executable cabal
+  build-depends:
+    HTTP       >= 4000.2.5 && < 4000.3,
+    mtl        >= 2.0      && < 3
+")
+
+(define-package-matcher match-ghc-foo-revision
+  ('package
+    ('name "ghc-foo")
+    ('version "1.0.0")
+    ('source
+     ('origin
+       ('method 'url-fetch)
+       ('uri ('string-append
+              "https://hackage.haskell.org/package/foo/foo-"
+              'version
+              ".tar.gz"))
+       ('sha256
+        ('base32
+         (? string? hash)))))
+    ('build-system 'haskell-build-system)
+    ('inputs
+     ('quasiquote
+      (("ghc-http" ('unquote 'ghc-http)))))
+    ('arguments
+     ('quasiquote
+      ('#:cabal-revision
+       ("2" "0xxd88fb659f0krljidbvvmkh9ppjnx83j0nqzx8whcg4n5qbyng"))))
+    ('home-page "http://test.org")
+    ('synopsis (? string?))
+    ('description (? string?))
+    ('license 'bsd-3)))
+
+(test-assert "hackage->guix-package test cabal revision"
+  (eval-test-with-cabal test-cabal-revision match-ghc-foo-revision))
+
 (test-assert "read-cabal test 1"
   (match (call-with-input-string test-read-cabal-1 read-cabal)
     ((("name" ("test-me"))
diff --git a/tests/utils.scm b/tests/utils.scm
index 44861384ab..f78ec356bd 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -230,6 +230,12 @@ skip these tests."
                "This is a journey\r\nInto the sound\r\nA journey ...\n")))
     (get-string-all (canonical-newline-port port))))
 
+(test-equal "canonical-newline-port-1024"
+  (string-concatenate (make-list 100 "0123456789abcde\n"))
+  (let ((port (open-string-input-port
+               (string-concatenate
+                (make-list 100 "0123456789abcde\r\n")))))
+    (get-string-all (canonical-newline-port port))))
 
 (test-equal "edit-expression"
   "(display \"GNU Guix\")\n(newline)\n"