diff options
| -rw-r--r-- | guix/inferior.scm | 26 | ||||
| -rw-r--r-- | tests/inferior.scm | 9 |
2 files changed, 35 insertions, 0 deletions
diff --git a/guix/inferior.scm b/guix/inferior.scm index ca819c6efff..3fa4930095c 100644 --- a/guix/inferior.scm +++ b/guix/inferior.scm | |||
| @@ -32,6 +32,7 @@ | |||
| 32 | #:use-module ((guix derivations) | 32 | #:use-module ((guix derivations) |
| 33 | #:select (read-derivation-from-file)) | 33 | #:select (read-derivation-from-file)) |
| 34 | #:use-module (guix gexp) | 34 | #:use-module (guix gexp) |
| 35 | #:use-module (guix search-paths) | ||
| 35 | #:use-module (srfi srfi-1) | 36 | #:use-module (srfi srfi-1) |
| 36 | #:use-module (srfi srfi-26) | 37 | #:use-module (srfi srfi-26) |
| 37 | #:use-module (ice-9 match) | 38 | #:use-module (ice-9 match) |
| @@ -58,6 +59,9 @@ | |||
| 58 | inferior-package-native-inputs | 59 | inferior-package-native-inputs |
| 59 | inferior-package-propagated-inputs | 60 | inferior-package-propagated-inputs |
| 60 | inferior-package-transitive-propagated-inputs | 61 | inferior-package-transitive-propagated-inputs |
| 62 | inferior-package-native-search-paths | ||
| 63 | inferior-package-transitive-native-search-paths | ||
| 64 | inferior-package-search-paths | ||
| 61 | inferior-package-derivation)) | 65 | inferior-package-derivation)) |
| 62 | 66 | ||
| 63 | ;;; Commentary: | 67 | ;;; Commentary: |
| @@ -322,6 +326,28 @@ inferior package." | |||
| 322 | (define inferior-package-transitive-propagated-inputs | 326 | (define inferior-package-transitive-propagated-inputs |
| 323 | (cut inferior-package-input-field <> 'package-transitive-propagated-inputs)) | 327 | (cut inferior-package-input-field <> 'package-transitive-propagated-inputs)) |
| 324 | 328 | ||
| 329 | (define (%inferior-package-search-paths package field) | ||
| 330 | "Return the list of search path specificiations of PACKAGE, an inferior | ||
| 331 | package." | ||
| 332 | (define paths | ||
| 333 | (inferior-package-field package | ||
| 334 | `(compose (lambda (paths) | ||
| 335 | (map (@ (guix search-paths) | ||
| 336 | search-path-specification->sexp) | ||
| 337 | paths)) | ||
| 338 | ,field))) | ||
| 339 | |||
| 340 | (map sexp->search-path-specification paths)) | ||
| 341 | |||
| 342 | (define inferior-package-native-search-paths | ||
| 343 | (cut %inferior-package-search-paths <> 'package-native-search-paths)) | ||
| 344 | |||
| 345 | (define inferior-package-search-paths | ||
| 346 | (cut %inferior-package-search-paths <> 'package-search-paths)) | ||
| 347 | |||
| 348 | (define inferior-package-transitive-native-search-paths | ||
| 349 | (cut %inferior-package-search-paths <> 'package-transitive-native-search-paths)) | ||
| 350 | |||
| 325 | (define (proxy client backend) ;adapted from (guix ssh) | 351 | (define (proxy client backend) ;adapted from (guix ssh) |
| 326 | "Proxy communication between CLIENT and BACKEND until CLIENT closes the | 352 | "Proxy communication between CLIENT and BACKEND until CLIENT closes the |
| 327 | connection, at which point CLIENT is closed (both CLIENT and BACKEND must be | 353 | connection, at which point CLIENT is closed (both CLIENT and BACKEND must be |
diff --git a/tests/inferior.scm b/tests/inferior.scm index 03170a19c9f..99d736bd40f 100644 --- a/tests/inferior.scm +++ b/tests/inferior.scm | |||
| @@ -140,6 +140,15 @@ | |||
| 140 | (close-inferior inferior) | 140 | (close-inferior inferior) |
| 141 | result)) | 141 | result)) |
| 142 | 142 | ||
| 143 | (test-equal "inferior-package-search-paths" | ||
| 144 | (package-native-search-paths guile-2.2) | ||
| 145 | (let* ((inferior (open-inferior %top-builddir | ||
| 146 | #:command "scripts/guix")) | ||
| 147 | (guile (first (lookup-inferior-packages inferior "guile"))) | ||
| 148 | (result (inferior-package-native-search-paths guile))) | ||
| 149 | (close-inferior inferior) | ||
| 150 | result)) | ||
| 151 | |||
| 143 | (test-equal "inferior-package-derivation" | 152 | (test-equal "inferior-package-derivation" |
| 144 | (map derivation-file-name | 153 | (map derivation-file-name |
| 145 | (list (package-derivation %store %bootstrap-guile "x86_64-linux") | 154 | (list (package-derivation %store %bootstrap-guile "x86_64-linux") |
