This adds failing test cases for two hackage import bugs: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=25138 https://debbugs.gnu.org/cgi/bugreport.cgi?bug=35743 * tests/hackage.scm: Make comment style consistent. Add two cabal parsing tests, marked as expected failures. Signed-off-by: Ludovic Courtès <ludo@gnu.org>
		
			
				
	
	
		
			390 lines
		
	
	
	
		
			10 KiB
		
	
	
	
		
			Scheme
		
	
	
	
	
	
			
		
		
	
	
			390 lines
		
	
	
	
		
			10 KiB
		
	
	
	
		
			Scheme
		
	
	
	
	
	
;;; 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.
 | 
						|
;;;
 | 
						|
;;; GNU Guix is free software; you can redistribute it and/or modify it
 | 
						|
;;; under the terms of the GNU General Public License as published by
 | 
						|
;;; the Free Software Foundation; either version 3 of the License, or (at
 | 
						|
;;; your option) any later version.
 | 
						|
;;;
 | 
						|
;;; GNU Guix is distributed in the hope that it will be useful, but
 | 
						|
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
 | 
						|
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 | 
						|
;;; GNU General Public License for more details.
 | 
						|
;;;
 | 
						|
;;; You should have received a copy of the GNU General Public License
 | 
						|
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 | 
						|
 | 
						|
(define-module (test-hackage)
 | 
						|
  #:use-module (guix import cabal)
 | 
						|
  #:use-module (guix import hackage)
 | 
						|
  #:use-module (guix tests)
 | 
						|
  #:use-module (srfi srfi-64)
 | 
						|
  #:use-module (ice-9 match))
 | 
						|
 | 
						|
(define test-cabal-1
 | 
						|
  "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
 | 
						|
")
 | 
						|
 | 
						|
(define test-cabal-2
 | 
						|
  "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
 | 
						|
}
 | 
						|
")
 | 
						|
 | 
						|
;; Check compiler implementation test with and without spaces.
 | 
						|
(define test-cabal-3
 | 
						|
  "name: foo
 | 
						|
version: 1.0.0
 | 
						|
homepage: http://test.org
 | 
						|
synopsis: synopsis
 | 
						|
description: description
 | 
						|
license: BSD3
 | 
						|
library
 | 
						|
  if impl(ghc >= 7.2 && < 7.6)
 | 
						|
    Build-depends: ghc-a
 | 
						|
  if impl(ghc>=7.2&&<7.6)
 | 
						|
    Build-depends: ghc-b
 | 
						|
  if impl(ghc == 7.8)
 | 
						|
    Build-depends: 
 | 
						|
      HTTP       >= 4000.2.5 && < 4000.3,
 | 
						|
      mtl        >= 2.0      && < 3
 | 
						|
")
 | 
						|
 | 
						|
;; Check "-any", "-none" when name is different.
 | 
						|
(define test-cabal-4
 | 
						|
  "name: foo
 | 
						|
version: 1.0.0
 | 
						|
homepage: http://test.org
 | 
						|
synopsis: synopsis
 | 
						|
description: description
 | 
						|
license: BSD3
 | 
						|
library
 | 
						|
  if impl(ghcjs -any)
 | 
						|
    Build-depends: ghc-a
 | 
						|
  if impl(ghc>=7.2&&<7.6)
 | 
						|
    Build-depends: ghc-b
 | 
						|
  if impl(ghc == 7.8)
 | 
						|
    Build-depends: 
 | 
						|
      HTTP       >= 4000.2.5 && < 4000.3,
 | 
						|
      mtl        >= 2.0      && < 3
 | 
						|
")
 | 
						|
 | 
						|
;; Check "-any", "-none".
 | 
						|
(define test-cabal-5
 | 
						|
  "name: foo
 | 
						|
version: 1.0.0
 | 
						|
homepage: http://test.org
 | 
						|
synopsis: synopsis
 | 
						|
description: description
 | 
						|
license: BSD3
 | 
						|
library
 | 
						|
  if impl(ghc == 7.8)
 | 
						|
    Build-depends: 
 | 
						|
      HTTP       >= 4000.2.5 && < 4000.3,
 | 
						|
  if impl(ghc -any)
 | 
						|
    Build-depends: mtl        >= 2.0      && < 3
 | 
						|
  if impl(ghc>=7.2&&<7.6)
 | 
						|
    Build-depends: ghc-b
 | 
						|
")
 | 
						|
 | 
						|
;; Check "custom-setup".
 | 
						|
(define test-cabal-6
 | 
						|
  "name: foo
 | 
						|
build-type: Custom
 | 
						|
version: 1.0.0
 | 
						|
homepage: http://test.org
 | 
						|
synopsis: synopsis
 | 
						|
description: description
 | 
						|
license: BSD3
 | 
						|
custom-setup
 | 
						|
  setup-depends: base >= 4.7 && < 5,
 | 
						|
                 Cabal >= 1.24,
 | 
						|
                 haskell-gi == 0.21.*
 | 
						|
library
 | 
						|
  if impl(ghc>=7.2&&<7.6)
 | 
						|
    Build-depends: ghc-b
 | 
						|
  if impl(ghc == 7.8)
 | 
						|
    Build-depends: 
 | 
						|
      HTTP       >= 4000.2.5 && < 4000.3,
 | 
						|
      mtl        >= 2.0      && < 3
 | 
						|
")
 | 
						|
 | 
						|
;; A fragment of a real Cabal file with minor modification to check precedence
 | 
						|
;; of 'and' over 'or', missing final newline, spaces between keywords and
 | 
						|
;; parentheses and between key and column.
 | 
						|
(define test-read-cabal-1
 | 
						|
  "name: test-me
 | 
						|
library
 | 
						|
  -- Choose which library versions to use.
 | 
						|
  if flag(base4point8)
 | 
						|
    Build-depends: base >= 4.8 && < 5
 | 
						|
  else
 | 
						|
    if flag(base4)
 | 
						|
      Build-depends: base >= 4 && < 4.8
 | 
						|
    else
 | 
						|
      if flag(base3)
 | 
						|
        Build-depends: base >= 3 && < 4
 | 
						|
      else
 | 
						|
        Build-depends: base < 3
 | 
						|
  if flag(base4point8) || flag (base4) && flag(base3)
 | 
						|
    Build-depends: random
 | 
						|
  Build-depends : containers
 | 
						|
 | 
						|
  -- Modules that are always built.
 | 
						|
  Exposed-Modules:
 | 
						|
    Test.QuickCheck.Exception")
 | 
						|
 | 
						|
(test-begin "hackage")
 | 
						|
 | 
						|
(define-syntax-rule (define-package-matcher name pattern)
 | 
						|
  (define* (name obj)
 | 
						|
    (match obj
 | 
						|
      (pattern #t)
 | 
						|
      (x       (pk 'fail x #f)))))
 | 
						|
 | 
						|
(define-package-matcher match-ghc-foo
 | 
						|
  ('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)))))
 | 
						|
    ('home-page "http://test.org")
 | 
						|
    ('synopsis (? string?))
 | 
						|
    ('description (? string?))
 | 
						|
    ('license 'bsd-3)))
 | 
						|
 | 
						|
(define* (eval-test-with-cabal test-cabal matcher #:key (cabal-environment '()))
 | 
						|
  (define port (open-input-string test-cabal))
 | 
						|
  (matcher (hackage->guix-package "foo" #:port port #:cabal-environment cabal-environment)))
 | 
						|
 | 
						|
(test-assert "hackage->guix-package test 1"
 | 
						|
  (eval-test-with-cabal test-cabal-1 match-ghc-foo))
 | 
						|
 | 
						|
(test-assert "hackage->guix-package test 2"
 | 
						|
  (eval-test-with-cabal test-cabal-2 match-ghc-foo))
 | 
						|
 | 
						|
(test-assert "hackage->guix-package test 3"
 | 
						|
  (eval-test-with-cabal test-cabal-3 match-ghc-foo
 | 
						|
                        #:cabal-environment '(("impl" . "ghc-7.8"))))
 | 
						|
 | 
						|
(test-assert "hackage->guix-package test 4"
 | 
						|
  (eval-test-with-cabal test-cabal-4 match-ghc-foo
 | 
						|
                        #:cabal-environment '(("impl" . "ghc-7.8"))))
 | 
						|
 | 
						|
(test-assert "hackage->guix-package test 5"
 | 
						|
  (eval-test-with-cabal test-cabal-5 match-ghc-foo
 | 
						|
                        #:cabal-environment '(("impl" . "ghc-7.8"))))
 | 
						|
 | 
						|
(define-package-matcher match-ghc-foo-6
 | 
						|
  ('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-b" ('unquote 'ghc-b))
 | 
						|
       ("ghc-http" ('unquote 'ghc-http)))))
 | 
						|
    ('native-inputs
 | 
						|
     ('quasiquote
 | 
						|
      (("ghc-haskell-gi" ('unquote 'ghc-haskell-gi)))))
 | 
						|
    ('home-page "http://test.org")
 | 
						|
    ('synopsis (? string?))
 | 
						|
    ('description (? string?))
 | 
						|
    ('license 'bsd-3)))
 | 
						|
 | 
						|
(test-assert "hackage->guix-package test 6"
 | 
						|
  (eval-test-with-cabal test-cabal-6 match-ghc-foo-6))
 | 
						|
 | 
						|
;; Check multi-line layouted description.
 | 
						|
(define test-cabal-multiline-layout
 | 
						|
  "name: foo
 | 
						|
version: 1.0.0
 | 
						|
homepage: http://test.org
 | 
						|
synopsis: synopsis
 | 
						|
description:   first line
 | 
						|
               second line
 | 
						|
license: BSD3
 | 
						|
executable cabal
 | 
						|
  build-depends:
 | 
						|
    HTTP       >= 4000.2.5 && < 4000.3,
 | 
						|
    mtl        >= 2.0      && < 3
 | 
						|
")
 | 
						|
 | 
						|
(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.
 | 
						|
(define test-cabal-multiline-braced
 | 
						|
  "name: foo
 | 
						|
version: 1.0.0
 | 
						|
homepage: http://test.org
 | 
						|
synopsis: synopsis
 | 
						|
description: {
 | 
						|
first line
 | 
						|
second line
 | 
						|
}
 | 
						|
license: BSD3
 | 
						|
executable cabal
 | 
						|
  build-depends:
 | 
						|
    HTTP       >= 4000.2.5 && < 4000.3,
 | 
						|
    mtl        >= 2.0      && < 3
 | 
						|
")
 | 
						|
 | 
						|
(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"))
 | 
						|
      ('section 'library
 | 
						|
                (('if ('flag "base4point8")
 | 
						|
                      (("build-depends" ("base >= 4.8 && < 5")))
 | 
						|
                      (('if ('flag "base4")
 | 
						|
                            (("build-depends" ("base >= 4 && < 4.8")))
 | 
						|
                            (('if ('flag "base3")
 | 
						|
                                  (("build-depends" ("base >= 3 && < 4")))
 | 
						|
                                  (("build-depends" ("base < 3"))))))))
 | 
						|
                 ('if ('or ('flag "base4point8")
 | 
						|
                           ('and ('flag "base4") ('flag "base3")))
 | 
						|
                      (("build-depends" ("random")))
 | 
						|
                      ())
 | 
						|
                 ("build-depends" ("containers"))
 | 
						|
                 ("exposed-modules" ("Test.QuickCheck.Exception")))))
 | 
						|
     #t)
 | 
						|
    (x (pk 'fail x #f))))
 | 
						|
 | 
						|
(test-end "hackage")
 |