diff options
| -rw-r--r-- | genenetwork-development.scm | 152 |
1 files changed, 75 insertions, 77 deletions
diff --git a/genenetwork-development.scm b/genenetwork-development.scm index 413afdb..9e5e242 100644 --- a/genenetwork-development.scm +++ b/genenetwork-development.scm @@ -1593,30 +1593,38 @@ delete-test-users, etc.) as the genenetwork user via sudo." "SSL_PRIVATE_KEY=\"" gn-auth-secrets "/gn-auth-ssl-private-key.pem\"\n")) (gn-libs-checkout (string-append repositories-checkout-directory "/gn-libs")) - (gn-auth-checkout (string-append repositories-checkout-directory "/gn-auth"))) + (gn-auth-checkout (string-append repositories-checkout-directory "/gn-auth")) + (gn-guile-checkout (string-append repositories-checkout-directory "/gn-guile")) + (gn3-checkout (string-append repositories-checkout-directory "/genenetwork3")) + (gn2-checkout (string-append repositories-checkout-directory "/genenetwork2"))) (program-file "gn-auth-test-flask" (with-imported-modules '((guix build utils)) #~(begin (use-modules (guix build utils)) - (define (hline) - "Print a horizontal line 50 '=' characters long." - (display (make-string 50 #\=)) + (define* (hline #:optional (char #\=)) + "Print a horizontal line 50 `char' characters long." + (display (make-string 50 char)) (newline) (force-output)) - (define (show-head-commit) - (hline) - (invoke #$(file-append git-minimal "/bin/git") - "log" "--max-count" "1") - (hline)) - (with-directory-excursion #$gn-libs-checkout - (show-head-commit)) - (with-directory-excursion #$gn-auth-checkout - (show-head-commit)) - - (setenv "PYTHONPATH" + (define* (show-head-commit #:optional (path #f)) + (hline) + (display (basename (or path (getcwd)))) (newline) + (hline #\-) + (invoke #$(file-append git-minimal "/bin/git") + "-C" (or path (getcwd)) + "--no-pager" "log" "--max-count" "1") + (hline)) + + (show-head-commit #$gn-libs-checkout) + (show-head-commit #$gn-auth-checkout) + (show-head-commit #$gn-guile-checkout) + (show-head-commit #$gn3-checkout) + (show-head-commit #$gn2-checkout) + + (setenv "PYTHONPATH" (string-append #$gn-libs-checkout ":" #$gn-auth-checkout ":" #$gn-auth-profile @@ -1675,75 +1683,65 @@ delete-test-users, etc.) as the genenetwork user via sudo." (setup '()) (teardown '())) (match-record config <genenetwork-configuration> - (gn-integration-tests-repository repositories-checkout-directory) - (let ((gn-libs-checkout (string-append repositories-checkout-directory "/gn-libs")) - (gn-auth-checkout (string-append repositories-checkout-directory "/gn-auth")) - (gn3-checkout (string-append repositories-checkout-directory "/genenetwork3")) - (gn2-checkout (string-append repositories-checkout-directory "/genenetwork2")) - (gn-guile-checkout (string-append repositories-checkout-directory "/gn-guile"))) - (with-imported-modules '((guix build utils)) - (with-packages (list nss-certs git-minimal) - #~(begin - (use-modules (guix build utils)) + (gn-integration-tests-repository) + (with-imported-modules '((guix build utils)) + (with-packages (list nss-certs git-minimal) + #~(begin + (use-modules (guix build utils)) - (define (hline) - "Print a horizontal line 50 '=' characters long." - (display (make-string 50 #\=)) - (newline) - (force-output)) + (define* (hline #:optional (char #\=)) + "Print a horizontal line 50 `char' characters long." + (display (make-string 50 char)) + (newline) + (force-output)) - (define (show-head-commit) + (define* (show-head-commit #:optional (path #f)) (hline) + (display (basename (or path (getcwd)))) (newline) + (hline #\-) (invoke #$(file-append git-minimal "/bin/git") + "-C" (or path (getcwd)) "--no-pager" "log" "--max-count" "1") (hline)) - - ;; laminar user cannot `cd' into some (or all) of these directories - ;; (with-directory-excursion #$gn-libs-checkout (show-head-commit)) - ;; (with-directory-excursion #$gn-auth-checkout (show-head-commit)) - ;; (with-directory-excursion #$gn-guile-checkout (show-head-commit)) - ;; (with-directory-excursion #$gn3-checkout (show-head-commit)) - ;; (with-directory-excursion #$gn2-checkout (show-head-commit)) - - (let* ((orig-dir (getcwd)) - (tmp-dir (mkdtemp "/tmp/gn-integration-tests.XXXXXX")) - (tests-profile #$(profile - (content (package->development-manifest gn-integration-tests)) - (allow-collisions? #t))) - (py-version - #$(version-major+minor (package-version python))) - (site-packages - (string-append tests-profile "/lib/python" - py-version "/site-packages"))) - (chdir tmp-dir) - (invoke #$(file-append git-minimal "/bin/git") - "clone" "--depth" "1" #$gn-integration-tests-repository) - (with-directory-excursion "gn-integration-tests" - (show-head-commit)) - (chdir "gn-integration-tests") - - (setenv "GN_INTEGRATION_TESTS_PROFILE" tests-profile) - (setenv "PATH" (string-append tests-profile "/bin:" - (getenv "PATH"))) - (if (getenv "PYTHONPATH") - (setenv - "PYTHONPATH" - (string-append site-packages ":" (getenv "PYTHONPATH"))) - (setenv "PYTHONPATH" site-packages)) - (dynamic-wind - (lambda () ;; Run setup if provided - #$(if (null? setup) - #~(if #f #f) - #~(begin #$@setup))) - (lambda () (apply invoke '#$test-command)) ;; Run actual tests - (lambda () ;; Always run teardowns to clean up. - (begin ;; run if teardowns provided - ;; we don't need `null?' check here because we have other - ;; statements therefore the `lambda' does not end up empty. - #$@teardown) - (chdir orig-dir) - (delete-file-recursively tmp-dir)))))))))) + (let* ((orig-dir (getcwd)) + (tmp-dir (mkdtemp "/tmp/gn-integration-tests.XXXXXX")) + (tests-profile #$(profile + (content (package->development-manifest gn-integration-tests)) + (allow-collisions? #t))) + (py-version + #$(version-major+minor (package-version python))) + (site-packages + (string-append tests-profile "/lib/python" + py-version "/site-packages"))) + (chdir tmp-dir) + (invoke #$(file-append git-minimal "/bin/git") + "clone" "--depth" "1" #$gn-integration-tests-repository) + (with-directory-excursion "gn-integration-tests" + (show-head-commit)) + (chdir "gn-integration-tests") + + (setenv "GN_INTEGRATION_TESTS_PROFILE" tests-profile) + (setenv "PATH" (string-append tests-profile "/bin:" + (getenv "PATH"))) + (if (getenv "PYTHONPATH") + (setenv + "PYTHONPATH" + (string-append site-packages ":" (getenv "PYTHONPATH"))) + (setenv "PYTHONPATH" site-packages)) + (dynamic-wind + (lambda () ;; Run setup if provided + #$(if (null? setup) + #~(if #f #f) + #~(begin #$@setup))) + (lambda () (apply invoke '#$test-command)) ;; Run actual tests + (lambda () ;; Always run teardowns to clean up. + (begin ;; run if teardowns provided + ;; we don't need `null?' check here because we have other + ;; statements therefore the `lambda' does not end up empty. + #$@teardown) + (chdir orig-dir) + (delete-file-recursively tmp-dir))))))))) (define (override-fcgiwrap-extension cgit-service) (service |