diff options
| -rw-r--r-- | guix/import/cran.scm | 36 | ||||
| -rw-r--r-- | tests/import/cran.scm | 19 |
2 files changed, 41 insertions, 14 deletions
diff --git a/guix/import/cran.scm b/guix/import/cran.scm index a3d008b7cfc..b24a732af97 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm | |||
| @@ -59,6 +59,7 @@ | |||
| 59 | %bioconductor-version | 59 | %bioconductor-version |
| 60 | download | 60 | download |
| 61 | fetch-description | 61 | fetch-description |
| 62 | extract-imports | ||
| 62 | 63 | ||
| 63 | cran->guix-package | 64 | cran->guix-package |
| 64 | bioconductor->guix-package | 65 | bioconductor->guix-package |
| @@ -573,9 +574,27 @@ referenced in build system files." | |||
| 573 | ;; Or perhaps... | 574 | ;; Or perhaps... |
| 574 | "|" | 575 | "|" |
| 575 | ;; ...direct namespace access. | 576 | ;; ...direct namespace access. |
| 576 | " *([A-Za-z0-9]+):::?" | 577 | " *([A-Za-z0-9._]+):::?" |
| 577 | ")"))) | 578 | ")"))) |
| 578 | 579 | ||
| 580 | (define* (extract-imports line | ||
| 581 | #:key (initial-set (set)) (ignored-names (list))) | ||
| 582 | "Return a set of strings corresponding to R libraries that are directly | ||
| 583 | referenced by namespace on LINE." | ||
| 584 | (fold (lambda (match acc) | ||
| 585 | (let ((imported (or (match:substring match 4) | ||
| 586 | (match:substring match 5)))) | ||
| 587 | (if (or (not imported) | ||
| 588 | ;; Likely inside a string. | ||
| 589 | (odd? (string-count (match:prefix match) #\")) | ||
| 590 | ;; Part of a bigger expression. | ||
| 591 | (string-suffix? ":" (match:prefix match)) | ||
| 592 | (member imported ignored-names)) | ||
| 593 | acc | ||
| 594 | (set-insert imported acc)))) | ||
| 595 | initial-set | ||
| 596 | (list-matches import-pattern line))) | ||
| 597 | |||
| 579 | (define (needed-test-inputs-in-directory dir) | 598 | (define (needed-test-inputs-in-directory dir) |
| 580 | "Return a set of R package names that are found in library import | 599 | "Return a set of R package names that are found in library import |
| 581 | statements in files in the directory DIR." | 600 | statements in files in the directory DIR." |
| @@ -598,17 +617,10 @@ statements in files in the directory DIR." | |||
| 598 | (cond | 617 | (cond |
| 599 | ((eof-object? line) packages) | 618 | ((eof-object? line) packages) |
| 600 | (else | 619 | (else |
| 601 | (loop | 620 | (loop (extract-imports line |
| 602 | (fold (lambda (match acc) | 621 | #:initial-set packages |
| 603 | (let ((imported (or (match:substring match 4) | 622 | #:ignored-names (cons package-directory-name |
| 604 | (match:substring match 5)))) | 623 | default-r-packages)))))))))) |
| 605 | (if (or (not imported) | ||
| 606 | (string=? imported package-directory-name) | ||
| 607 | (member imported default-r-packages)) | ||
| 608 | acc | ||
| 609 | (set-insert imported acc)))) | ||
| 610 | packages | ||
| 611 | (list-matches import-pattern line)))))))))) | ||
| 612 | (set) | 624 | (set) |
| 613 | (append-map (lambda (directory) | 625 | (append-map (lambda (directory) |
| 614 | (find-files directory "\\.(R|Rmd)")) | 626 | (find-files directory "\\.(R|Rmd)")) |
diff --git a/tests/import/cran.scm b/tests/import/cran.scm index 5c820b1ab32..6b1bcc297dd 100644 --- a/tests/import/cran.scm +++ b/tests/import/cran.scm | |||
| @@ -1,5 +1,5 @@ | |||
| 1 | ;;; GNU Guix --- Functional package management for GNU | 1 | ;;; GNU Guix --- Functional package management for GNU |
| 2 | ;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net> | 2 | ;;; Copyright © 2015, 2025 Ricardo Wurmus <rekado@elephly.net> |
| 3 | ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> | 3 | ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> |
| 4 | ;;; | 4 | ;;; |
| 5 | ;;; This file is part of GNU Guix. | 5 | ;;; This file is part of GNU Guix. |
| @@ -20,6 +20,7 @@ | |||
| 20 | (define-module (test-cran) | 20 | (define-module (test-cran) |
| 21 | #:use-module (gnu packages statistics) | 21 | #:use-module (gnu packages statistics) |
| 22 | #:use-module (guix import cran) | 22 | #:use-module (guix import cran) |
| 23 | #:use-module (guix sets) | ||
| 23 | #:use-module (guix tests) | 24 | #:use-module (guix tests) |
| 24 | #:use-module (srfi srfi-1) | 25 | #:use-module (srfi srfi-1) |
| 25 | #:use-module (srfi srfi-64) | 26 | #:use-module (srfi srfi-64) |
| @@ -88,7 +89,21 @@ Date/Publication: 2015-07-14 14:15:16 | |||
| 88 | '() | 89 | '() |
| 89 | ((@@ (guix import cran) listify) simple-alist "BadList")) | 90 | ((@@ (guix import cran) listify) simple-alist "BadList")) |
| 90 | 91 | ||
| 91 | (test-equal "r-mininal is not a cran package" | 92 | (test-equal "extract-imports: finds data.table" |
| 93 | (list "data.table") | ||
| 94 | (set->list ((@ (guix import cran) extract-imports) "abc + data.table::some_procedure()"))) | ||
| 95 | |||
| 96 | (test-equal "extract-imports: ignores text inside strings" | ||
| 97 | (list) | ||
| 98 | (set->list ((@ (guix import cran) extract-imports) | ||
| 99 | "\"hello::world\", \"this is not data.table::some_procedure(), actually\""))) | ||
| 100 | |||
| 101 | (test-equal "extract-imports: ignores other colon separated things" | ||
| 102 | (list) | ||
| 103 | (set->list ((@ (guix import cran) extract-imports) | ||
| 104 | "this:is:not::a:procedure"))) | ||
| 105 | |||
| 106 | (test-equal "r-minimal is not a cran package" | ||
| 92 | #f | 107 | #f |
| 93 | ((@@ (guix import cran) cran-package?) r-minimal)) | 108 | ((@@ (guix import cran) cran-package?) r-minimal)) |
| 94 | 109 | ||
