Package: guix-patches;
Reported by: Julien Lepiller <julien <at> lepiller.eu>
Date: Sun, 12 Jul 2020 22:22:02 UTC
Severity: normal
Tags: patch
Done: Steve George <steve <at> futurile.net>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: Nicolas Graves <ngraves <at> ngraves.fr> To: 42338 <at> debbugs.gnu.org Cc: ngraves <at> ngraves.fr Subject: [bug#42338] [PATCH 9/9] gnu: composer-build-system: Full check phase rewrite. Date: Thu, 2 Nov 2023 16:04:29 +0100
Change-Id: I824b27b925cd718ee83ef6b2ee4a8a1e69455de6
---
guix/build-system/composer.scm | 2 +
guix/build/composer-build-system.scm | 239 ++++++++++++++++-----------
2 files changed, 148 insertions(+), 93 deletions(-)
diff --git a/guix/build-system/composer.scm b/guix/build-system/composer.scm
index 8bf99ff9c5..7d2ad2b398 100644
--- a/guix/build-system/composer.scm
+++ b/guix/build-system/composer.scm
@@ -107,6 +107,7 @@ (define* (composer-build name inputs
(composer-file "composer.json")
(tests? #t)
(test-target "test")
+ (test-flags ''())
(install-target "install")
(validate-runpath? #t)
(patch-shebangs? #t)
@@ -140,6 +141,7 @@ (define builder
#:composer-file #$composer-file
#:tests? #$tests?
#:test-target #$test-target
+ #:test-flags #$test-flags
#:install-target #$install-target
#:validate-runpath? #$validate-runpath?
#:patch-shebangs? #$patch-shebangs?
diff --git a/guix/build/composer-build-system.scm b/guix/build/composer-build-system.scm
index bcbae27021..6f05801ad1 100644
--- a/guix/build/composer-build-system.scm
+++ b/guix/build/composer-build-system.scm
@@ -53,9 +53,22 @@ (define (if-specified-to-list fn)
(define-json-mapping <composer-autoload> make-composer-autoload
composer-autoload?
json->composer-autoload
- (psr-4 composer-autoload-psr-4 "psr-4" (if-specified-to-list identity))
+ (psr-4 composer-autoload-psr-4 "psr-4"
+ (match-lambda
+ ((? unspecified?) '())
+ ((? (lambda (al)
+ (and (list? al) (pair? (car al)) (vector? (cdar al)))) al)
+ (append-map
+ (lambda (vect-el)
+ (list (cons (caar al) vect-el)))
+ (vector->list (cdar al))))
+ ((? list? l) l)
+ (_ '())))
+ (psr-0 composer-autoload-psr-0 "psr-0" (if-specified-to-list identity))
(classmap composer-autoload-classmap "classmap"
- (if-specified-to-list vector->list)))
+ (if-specified-to-list vector->list))
+ (files composer-autoload-files "files"
+ (if-specified-to-list vector->list)))
(define-json-mapping <composer-package> make-composer-package composer-package?
json->composer-package
@@ -76,65 +89,57 @@ (define* (read-package-data #:key (filename "composer.json"))
(lambda (port)
(json->composer-package (json->scm port)))))
-(define* (check #:key composer-file inputs outputs tests? test-target #:allow-other-keys)
- "Test the given package."
+(define* (create-test-autoload #:key composer-file inputs outputs tests?
+ #:allow-other-keys)
+ "Create the autoload.php file for tests. This is a standalone phase so that
+the autoload.php file can be edited before the check phase."
(when tests?
(mkdir-p "vendor")
(create-autoload (string-append (getcwd) "/vendor") composer-file
- (append inputs outputs) #:dev-dependencies? #t)
- (let* ((package-data (read-package-data #:filename composer-file))
- (scripts (composer-package-scripts package-data))
- (test-script (assoc-ref scripts test-target))
- (dependencies (composer-package-require package-data))
- (dependencies-dev (composer-package-dev-require package-data))
- (name (composer-package-name package-data)))
- (for-each
- (match-lambda
- ((_ . input)
- (let ((bin (find-php-bin input)))
- (when bin
- (copy-recursively bin "vendor/bin")))))
- inputs)
- (match test-script
- ((? string? command)
- (unless (zero? (system command))
- (throw 'failed-command command)))
- (('@ (? string? command) ...)
- (for-each
- (lambda (c)
- (unless (zero? (system c))
- (throw 'failed-command c)))
- command))
- (#f (invoke "vendor/bin/phpunit"))))))
+ inputs #:dev-dependencies? #t)))
-(define (find-php-bin input)
- (let* ((web-dir (string-append input "/share/web"))
- (vendors (if (file-exists? web-dir)
- (find-files web-dir "^vendor$" #:directories? #t)
- #f)))
- (match vendors
- ((vendor)
- (let ((bin (string-append vendor "/bin")))
- (and (file-exists? bin) bin)))
- (_ #f))))
+(define (find-bin script inputs)
+ (search-input-file inputs
+ (string-append
+ "bin/"
+ (string-drop script (string-length "vendor/bin/")))))
-(define (find-php-dep inputs dependency)
- (let loop ((inputs inputs))
- (match inputs
- (() (throw 'unsatisfied-dependency "Unsatisfied dependency: required "
- dependency))
- (((_ . input) inputs ...)
- (let ((autoload (string-append input "/share/web/" dependency
- "/vendor/autoload_conf.php")))
- (if (file-exists? autoload)
- autoload
- (loop inputs))))
- ((input inputs ...)
- (let ((autoload (string-append input "/share/web/" dependency
- "/vendor/autoload_conf.php")))
- (if (file-exists? autoload)
- autoload
- (loop inputs)))))))
+(define* (check #:key composer-file inputs
+ tests? test-target test-flags #:allow-other-keys)
+ "Test the given package.
+Please note that none of the PHP packages at the time of the rewrite of the
+build-system did use the test-script field. This means that the @code{match
+test-script} part is not tested on a real example and relies on the original
+implementation."
+ (if tests?
+ (let* ((package-data (read-package-data #:filename composer-file))
+ (scripts (composer-package-scripts package-data))
+ (test-script (assoc-ref scripts test-target)))
+ (match test-script
+ ((? string? bin)
+ (let ((command (find-bin bin inputs)))
+ (unless (zero? (apply system command test-flags))
+ (throw 'failed-command command))))
+ (('@ (? string? bins) ...)
+ (for-each
+ (lambda (c)
+ (let ((command (find-bin bin inputs)))
+ (unless (zero? (apply system command test-flags))
+ (throw 'failed-command command))))
+ bins))
+ (_ (if (file-exists? "phpunit.xml.dist")
+ (apply invoke
+ (with-exception-handler
+ (lambda (exn)
+ (if (search-error? exn)
+ (error "\
+Missing php-phpunit-phpunit native input.~%")
+ (raise exn)))
+ (lambda ()
+ (search-input-file (or inputs '()) "bin/phpunit")))
+ test-flags))
+ (format #t "No test suite found.~%"))))
+ (format #t "Test suite not run.~%")))
(define* (create-autoload vendor composer-file inputs #:key dev-dependencies?)
"creates an autoload.php file that sets up the class locations for this package,
@@ -144,15 +149,14 @@ (define* (create-autoload vendor composer-file inputs #:key dev-dependencies?)
(display (string-append
"<?php
// autoload.php @generated by Guix
-$map = $psr4map = $classmap = array();
-require_once '" vendor "/autoload_conf.php'
-require_once '" (assoc-ref inputs "composer-classloader") "/share/web/composer/ClassLoader.php'
+$psr4map = $classmap = array();
+require_once '" vendor "/autoload_conf.php';
+require_once '" (assoc-ref inputs "composer-classloader") "/share/web/composer/ClassLoader.php';
$loader = new \\Composer\\Autoload\\ClassLoader();
-foreach ($map as $namespace => $path) {
- $loader->set($namespace, $path);
-}
-foreach ($psr4map as $namespace => $path) {
- $loader->setPsr4($namespace, $path);
+foreach ($psr4map as $namespace => $paths) {
+ foreach ($paths as $path) {
+ $loader->addPsr4($namespace, $path);
+ }
}
$loader->addClassMap($classmap);
$loader->register();
@@ -170,37 +174,85 @@ (define* (create-autoload vendor composer-file inputs #:key dev-dependencies?)
(format #t "// autoload_conf.php @generated by Guix~%")
(force-output)
(for-each
- (lambda (psr4)
- (match psr4
- ((key . value)
- (format #t "$psr4map['~a'] = '~a/../~a';~%"
- (string-join (string-split key #\\) "\\\\")
- vendor value))))
+ (match-lambda
+ ((key . value)
+ (let ((vals (if (list? value)
+ (reverse value)
+ (list value))))
+ (apply
+ format
+ #t
+ (string-append
+ "$psr4map['~a'][] = ["
+ (string-join
+ (make-list (length vals) "'~a/../~a'") ",")
+ "];~%")
+ (cons* (string-join (string-split key #\\) "\\\\")
+ (append-map (lambda (v) (list vendor v)) vals)))))
+ (_ (format #t "")))
+ (merge-duplicates
(append
- (composer-autoload-psr-4 autoload)
- (if dev-dependencies?
- (composer-autoload-psr-4 autoload-dev)
- '())))
+ (composer-autoload-psr-4 autoload)
+ (if (and dev-dependencies? (not (null? autoload-dev)))
+ (composer-autoload-psr-4 autoload-dev)
+ '()))
+ '()))
(for-each
- (lambda (classmap)
- (for-each
- (lambda (file)
- (invoke "php" (assoc-ref inputs "findclass.php")
- "-i" (string-append vendor "/..") "-f" file))
- (find-files classmap ".(php|hh|inc)$")))
- (append
- (composer-autoload-classmap autoload)
- (if dev-dependencies?
- (composer-autoload-classmap autoload-dev)
- '())))
+ (lambda (psr0)
+ (match psr0
+ ((key . value)
+ (format #t "$psr4map['~a'][] = ['~a/../~a/~a'];~%"
+ (string-join (string-split key #\\) "\\\\")
+ vendor
+ value
+ (string-join (string-split key #\\) "/")))
+ (_ (format #t ""))))
+ (append
+ (composer-autoload-psr-0 autoload)
+ (if (and dev-dependencies? (not (null? autoload-dev)))
+ (composer-autoload-psr-0 autoload-dev)
+ '())))
(for-each
- (lambda (dep)
- (format #t "require_once '~a';~%" (find-php-dep inputs dep)))
- (append
- dependencies
- (if dev-dependencies?
- dependencies-dev
- '())))))))
+ (lambda (classmap)
+ (for-each
+ (lambda (file)
+ (invoke "php" (assoc-ref inputs "findclass.php")
+ "-i" (string-append vendor "/..") "-f" file))
+ (find-files classmap ".(php|hh|inc)$")))
+ (append
+ (composer-autoload-classmap autoload)
+ (if (and dev-dependencies? (not (null? autoload-dev)))
+ (composer-autoload-classmap autoload-dev)
+ '())))
+ (for-each
+ (lambda (file)
+ (format #t "require_once '~a/../~a';~%" vendor file))
+ (append
+ (composer-autoload-files autoload)
+ (if (and dev-dependencies? (not (null? autoload-dev)))
+ (composer-autoload-files autoload-dev)
+ '())))
+ (for-each
+ (lambda (dep)
+ (format
+ #t "require_once '~a';~%"
+ (search-input-file
+ inputs
+ (string-append "/share/web/" dep "/vendor/autoload_conf.php"))))
+ dependencies)
+ ;; Also add native-inputs that are not necessarily given in the
+ ;; composer.json. This allows to simply add a package in tests by
+ ;; adding it in native-inputs, without the need to patch composer.json.
+ (for-each
+ (match-lambda
+ ((name . loc)
+ (match (find-files loc "autoload_conf\\.php$")
+ (() #t)
+ (((? string? conf) . ())
+ (format #t "require_once '~a';~%" conf))
+ (_ #t)))
+ (_ #t))
+ (or inputs '()))))))
(define* (install #:key inputs outputs composer-file #:allow-other-keys)
"Install the given package."
@@ -237,7 +289,8 @@ (define %standard-phases
(delete 'build)
(delete 'check)
(replace 'install install)
- (add-after 'install 'check check)))
+ (add-after 'install 'check check)
+ (add-after 'install 'create-test-autoload create-test-autoload)))
(define* (composer-build #:key inputs (phases %standard-phases)
#:allow-other-keys #:rest args)
--
2.41.0
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.