Subject: [bug#68517] [PATCH] guix: chicken-build-system: fixes to make it actually work

From: Daniel Ziltener <[email-masked]>
Date: Tue, 16 Jan 2024 22:05:04 +0100

---
  guix/build-system/chicken.scm       | 50 ++++++++++++++++++++---------
  guix/build/chicken-build-system.scm | 17 ++++------
  2 files changed, 40 insertions(+), 27 deletions(-)

diff --git a/guix/build-system/chicken.scm b/guix/build-system/chicken.scm
index 9f518e66e6..17c3b7b144 100644
--- a/guix/build-system/chicken.scm
+++ b/guix/build-system/chicken.scm
@@ -45,8 +45,8 @@ (define %chicken-build-system-modules
      ,@%gnu-build-system-modules))
  
  (define (default-chicken)
+  "Return the default Chicken package."
    ;; Lazily resolve the binding to avoid a circular dependency.
-  ;; TODO is this actually needed in every build system?
    (let ((chicken (resolve-interface '(gnu packages chicken))))
        (module-ref chicken 'chicken)))
  
@@ -77,18 +77,32 @@ (define private-keywords
                           ,@native-inputs))
           (outputs outputs)
           (build chicken-build)
-         (arguments (strip-keyword-arguments private-keywords arguments)))))
+         (arguments
+          (substitute-keyword-arguments
+              (strip-keyword-arguments private-keywords arguments)
+            ((#:extra-directories extra-directories)
+             `(list ,@(append-map
+                       (lambda (name)
+                         (match (assoc name inputs)
+                           ((_ pkg)
+                            (match (package-transitive-propagated-inputs pkg)
+                              (((propagated-names . _) ...)
+                               (cons name propagated-names))))))
+                       extra-directories))))))))
  
  (define* (chicken-build name inputs
                          #:key
                          source
                          (phases '%standard-phases)
-                        (outputs '("out"))
+                        (outputs '("out" "static"))
                          (search-paths '())
                          (egg-name "")
                          (unpack-path "")
                          (build-flags ''())
+                        (configure-flags ''())
+                        (extra-directories ''())
                          (tests? #t)
+                        (parallel-build? #f)
                          (system (%current-system))
                          (guile #f)
                          (imported-modules %chicken-build-system-modules)
@@ -99,19 +113,23 @@ (define builder
      (with-imported-modules imported-modules
        #~(begin
            (use-modules #$@(sexp->gexp modules))
-          (chicken-build #:name #$name
-                         #:source #+source
-                         #:system #$system
-                         #:phases #$phases
-                         #:outputs #$(outputs->gexp outputs)
-                         #:search-paths '#$(sexp->gexp
-                                            (map search-path-specification->sexp
-                                                 search-paths))
-                         #:egg-name #$egg-name
-                         #:unpack-path #$unpack-path
-                         #:build-flags #$build-flags
-                         #:tests? #$tests?
-                         #:inputs #$(input-tuples->gexp inputs)))))
+          #$(with-build-variables inputs-outputs
+                #~(chicken-build #:name #$name
+                                 #:source #+source
+                                 #:system #$system
+                                 #:phases #$phases
+                                 #:configure-flags #$configure-flags
+                                 #:extra-directories #$extra-directories
+                                 #:parallel-build? #$parallel-build?
+                                 #:outputs #$(outputs->gexp outputs)
+                                 #:search-paths '#$(sexp->gexp
+                                                    (map search-path-specification->sexp
+                                                         search-paths))
+                                 #:egg-name #$egg-name
+                                 #:unpack-path #$unpack-path
+                                 #:build-flags #$build-flags
+                                 #:tests? #$tests?
+                                 #:inputs #$(input-tuples->gexp inputs))))))
  
    (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
                                                    system #:graft? #f)))
diff --git a/guix/build/chicken-build-system.scm b/guix/build/chicken-build-system.scm
index 8f9f59cc25..6a4f0c43eb 100644
--- a/guix/build/chicken-build-system.scm
+++ b/guix/build/chicken-build-system.scm
@@ -42,13 +42,12 @@ (define (chicken-package? name)
  
  (define* (setup-chicken-environment #:key inputs outputs #:allow-other-keys)
    (setenv "CHICKEN_INSTALL_REPOSITORY"
-          (string-concatenate
-           ;; see TODO item about binary version above
-           (append (list (assoc-ref outputs "out") "/var/lib/chicken/11/")
-                   (let ((oldenv (getenv "CHICKEN_INSTALL_REPOSITORY")))
-                     (if oldenv
-                         (list  ":" oldenv)
-                         '())))))
+          (string-append (assoc-ref outputs "out") "/var/lib/chicken/11/"))
+  (setenv "CHICKEN_INSTALL_PREFIX"
+          (string-append (assoc-ref outputs "out") "/bin/"))
+  (setenv "CHICKEN_REPOSITORY_PATH"
+          (string-append (getenv "CHICKEN_REPOSITORY_PATH")
+                         ":" (getenv "CHICKEN_INSTALL_REPOSITORY")))
    (setenv "CHICKEN_EGG_CACHE" (getcwd))
    #t)
  
@@ -104,10 +103,6 @@ (define* (check #:key egg-name tests? #:allow-other-keys)
    ;; there is no "-test-only" option, but we've already run install
    ;; so this just runs tests.
    ;; i think it's a fair assumption that phases won't be reordered.
-  (setenv "CHICKEN_REPOSITORY_PATH"
-          (string-append (getenv "CHICKEN_INSTALL_REPOSITORY")
-                         ":"
-                         (getenv "CHICKEN_REPOSITORY_PATH")))
    (when tests?
      (invoke "chicken-install" "-cached" "-test" "-no-install" egg-name)))
  
-- 
2.43.0