diff options
Diffstat (limited to 'tests')
-rw-r--r-- | tests/lint.scm | 98 | ||||
-rw-r--r-- | tests/packages.scm | 12 | ||||
-rw-r--r-- | tests/scripts.scm | 72 | ||||
-rw-r--r-- | tests/ui.scm | 40 |
4 files changed, 181 insertions, 41 deletions
diff --git a/tests/lint.scm b/tests/lint.scm index ac47dbb768..3f149562d4 100644 --- a/tests/lint.scm +++ b/tests/lint.scm @@ -1,7 +1,8 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013 Cyril Roelandt <tipecaml@gmail.com> -;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org> +;;; Copyright © 2014, 2015 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2015 Mathieu Lirzin <mthl@openmailbox.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -21,6 +22,7 @@ (define-module (test-lint) #:use-module (guix tests) #:use-module (guix download) + #:use-module (guix git-download) #:use-module (guix build-system gnu) #:use-module (guix packages) #:use-module (guix scripts lint) @@ -141,6 +143,13 @@ requests." (check-description-style pkg))) "description should not be empty"))) +(test-assert "description: valid Texinfo markup" + (->bool + (string-contains + (with-warnings + (check-description-style (dummy-package "x" (description "f{oo}b@r")))) + "Texinfo markup in description is invalid"))) + (test-assert "description: does not start with an upper-case letter" (->bool (string-contains (with-warnings @@ -398,6 +407,83 @@ requests." (check-home-page pkg)))) "not reachable: 404"))) +(test-assert "source-file-name" + (->bool + (string-contains + (with-warnings + (let ((pkg (dummy-package "x" + (version "3.2.1") + (source + (origin + (method url-fetch) + (uri "http://www.example.com/3.2.1.tar.gz") + (sha256 %null-sha256)))))) + (check-source-file-name pkg))) + "file name should contain the package name"))) + +(test-assert "source-file-name: v prefix" + (->bool + (string-contains + (with-warnings + (let ((pkg (dummy-package "x" + (version "3.2.1") + (source + (origin + (method url-fetch) + (uri "http://www.example.com/v3.2.1.tar.gz") + (sha256 %null-sha256)))))) + (check-source-file-name pkg))) + "file name should contain the package name"))) + +(test-assert "source-file-name: bad checkout" + (->bool + (string-contains + (with-warnings + (let ((pkg (dummy-package "x" + (version "3.2.1") + (source + (origin + (method git-fetch) + (uri (git-reference + (url "http://www.example.com/x.git") + (commit "0"))) + (sha256 %null-sha256)))))) + (check-source-file-name pkg))) + "file name should contain the package name"))) + +(test-assert "source-file-name: good checkout" + (not + (->bool + (string-contains + (with-warnings + (let ((pkg (dummy-package "x" + (version "3.2.1") + (source + (origin + (method git-fetch) + (uri (git-reference + (url "http://git.example.com/x.git") + (commit "0"))) + (file-name (string-append "x-" version)) + (sha256 %null-sha256)))))) + (check-source-file-name pkg))) + "file name should contain the package name")))) + +(test-assert "source-file-name: valid" + (not + (->bool + (string-contains + (with-warnings + (let ((pkg (dummy-package "x" + (version "3.2.1") + (source + (origin + (method url-fetch) + (uri "http://www.example.com/x-3.2.1.tar.gz") + (sha256 %null-sha256)))))) + (check-source-file-name pkg))) + "file name should contain the package name")))) + (test-skip (if %http-server-socket 0 1)) (test-equal "source: 200" "" @@ -426,6 +512,16 @@ requests." (check-source pkg)))) "not reachable: 404"))) +(test-assert "formatting: lonely parentheses" + (string-contains + (with-warnings + (check-formatting + ( + dummy-package "ugly as hell!" + ) + )) + "lonely")) + (test-assert "formatting: tabulation" (string-contains (with-warnings diff --git a/tests/packages.scm b/tests/packages.scm index 00a0998b4c..ace2f36f19 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -177,6 +177,18 @@ (package-transitive-supported-systems d) (package-transitive-supported-systems e)))) +(test-equal "origin-actual-file-name" + "foo-1.tar.gz" + (let ((o (dummy-origin (uri "http://www.example.com/foo-1.tar.gz")))) + (origin-actual-file-name o))) + +(test-equal "origin-actual-file-name, file-name" + "foo-1.tar.gz" + (let ((o (dummy-origin + (uri "http://www.example.com/tarball") + (file-name "foo-1.tar.gz")))) + (origin-actual-file-name o))) + (let* ((o (dummy-origin)) (u (dummy-origin)) (i (dummy-origin)) diff --git a/tests/scripts.scm b/tests/scripts.scm new file mode 100644 index 0000000000..3bf41aed4d --- /dev/null +++ b/tests/scripts.scm @@ -0,0 +1,72 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org> +;;; +;;; 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-scripts) + #:use-module (guix scripts) + #:use-module ((guix scripts build) + #:select (%standard-build-options)) + #:use-module (srfi srfi-64)) + +;; Test the (guix scripts) module. + +(define-syntax-rule (with-environment-variable variable value body ...) + "Run BODY with VARIABLE set to VALUE." + (let ((orig (getenv variable))) + (dynamic-wind + (lambda () + (setenv variable value)) + (lambda () + body ...) + (lambda () + (if orig + (setenv variable orig) + (unsetenv variable)))))) + + +(test-begin "scripts") + +(test-equal "parse-command-line" + '((argument . "bar") (argument . "foo") + (cores . 10) ;takes precedence + (substitutes? . #f) (keep-failed? . #t) + (max-jobs . 77) (cores . 42)) + + (with-environment-variable "GUIX_BUILD_OPTIONS" "-c 42 -M 77" + (parse-command-line '("--keep-failed" "--no-substitutes" + "--cores=10" "foo" "bar") + %standard-build-options + (list '())))) + +(test-equal "parse-command-line and --no options" + '((argument . "foo") + (substitutes? . #f)) ;takes precedence + + (with-environment-variable "GUIX_BUILD_OPTIONS" "--no-substitutes" + (parse-command-line '("foo") + %standard-build-options + (list '((substitutes? . #t)))))) + +(test-end "scripts") + + +(exit (= (test-runner-fail-count (test-runner-current)) 0)) + +;;; Local Variables: +;;; eval: (put 'with-environment-variable 'scheme-indent-function 2) +;;; End: diff --git a/tests/ui.scm b/tests/ui.scm index 1478fe213e..25fc709431 100644 --- a/tests/ui.scm +++ b/tests/ui.scm @@ -22,8 +22,6 @@ #:use-module (guix profiles) #:use-module (guix store) #:use-module (guix derivations) - #:use-module ((guix scripts build) - #:select (%standard-build-options)) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-19) @@ -54,43 +52,9 @@ interface, and powerful string processing.") (item "/gnu/store/...") (output "out"))) -(define-syntax-rule (with-environment-variable variable value body ...) - "Run BODY with VARIABLE set to VALUE." - (let ((orig (getenv variable))) - (dynamic-wind - (lambda () - (setenv variable value)) - (lambda () - body ...) - (lambda () - (if orig - (setenv variable orig) - (unsetenv variable)))))) - (test-begin "ui") -(test-equal "parse-command-line" - '((argument . "bar") (argument . "foo") - (cores . 10) ;takes precedence - (substitutes? . #f) (keep-failed? . #t) - (max-jobs . 77) (cores . 42)) - - (with-environment-variable "GUIX_BUILD_OPTIONS" "-c 42 -M 77" - (parse-command-line '("--keep-failed" "--no-substitutes" - "--cores=10" "foo" "bar") - %standard-build-options - (list '())))) - -(test-equal "parse-command-line and --no options" - '((argument . "foo") - (substitutes? . #f)) ;takes precedence - - (with-environment-variable "GUIX_BUILD_OPTIONS" "--no-substitutes" - (parse-command-line '("foo") - %standard-build-options - (list '((substitutes? . #t)))))) - (test-assert "fill-paragraph" (every (lambda (column) (every (lambda (width) @@ -282,7 +246,3 @@ Second line" 24)) (exit (= (test-runner-fail-count (test-runner-current)) 0)) - -;;; Local Variables: -;;; eval: (put 'with-environment-variable 'scheme-indent-function 2) -;;; End: |