[bug#42338] [PATCH v5 9/9] gnu: composer-build-system: Full check phase rewrite.

[Nicolas Graves via Guix-patches via <guix-patches@gnu.org>]

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