aboutsummaryrefslogtreecommitdiff
path: root/test/compress/issue-1833.js
diff options
context:
space:
mode:
authorAlex Lam S.L <alexlamsl@gmail.com>2021-01-15 18:37:27 +0000
committerGitHub <noreply@github.com>2021-01-16 02:37:27 +0800
commit74368c3dba66ce4c3d09f0a243a7a6eb55e9d85e (patch)
treed31594301d82f6f871fd36e8b6c965b0d573af18 /test/compress/issue-1833.js
parent18dbceb36f02db6100c1588a77c18c6ca73f1baa (diff)
downloadtracifyjs-74368c3dba66ce4c3d09f0a243a7a6eb55e9d85e.tar.gz
tracifyjs-74368c3dba66ce4c3d09f0a243a7a6eb55e9d85e.zip
fix corner case in `unused` (#4559)
fixes #4558
Diffstat (limited to 'test/compress/issue-1833.js')
0 files changed, 0 insertions, 0 deletions
age)) lst)) '()) (lambda (x y) (string<? (car x) (car y)))) 10) (let* ((inferior (open-inferior %top-builddir #:command "scripts/guix")) (packages (inferior-packages inferior))) (and (every string? (map inferior-package-synopsis packages)) (let () (define result (take (sort (map (lambda (package) (list (inferior-package-name package) (inferior-package-version package) (inferior-package-home-page package) (inferior-package-location package))) packages) (lambda (x y) (string<? (car x) (car y)))) 10)) (close-inferior inferior) result)))) (test-equal "inferior-available-packages" (take (sort (fold-available-packages (lambda* (name version result #:key supported? deprecated? #:allow-other-keys) (if (and supported? (not deprecated?)) (alist-cons name version result) result)) '()) (lambda (x y) (string<? (car x) (car y)))) 10) (let* ((inferior (open-inferior %top-builddir #:command "scripts/guix")) (packages (inferior-available-packages inferior))) (close-inferior inferior) (take (sort packages (lambda (x y) (string<? (car x) (car y)))) 10))) (test-equal "lookup-inferior-packages" (let ((->list (lambda (package) (list (package-name package) (package-version package) (package-location package))))) (list (map ->list (find-packages-by-name "guile" #f)) (map ->list (find-packages-by-name "guile" "2.2")))) (let* ((inferior (open-inferior %top-builddir #:command "scripts/guix")) (->list (lambda (package) (list (inferior-package-name package) (inferior-package-version package) (inferior-package-location package)))) (lst1 (map ->list (lookup-inferior-packages inferior "guile"))) (lst2 (map ->list (lookup-inferior-packages inferior "guile" "2.2")))) (close-inferior inferior) (list lst1 lst2))) (test-assert "lookup-inferior-packages and eq?-ness" (let* ((inferior (open-inferior %top-builddir #:command "scripts/guix")) (lst1 (lookup-inferior-packages inferior "guile")) (lst2 (lookup-inferior-packages inferior "guile"))) (close-inferior inferior) (every eq? lst1 lst2))) (test-equal "inferior-package-inputs" (let ((->list (match-lambda ((label (? package? package) . rest) `(,label (package ,(package-name package) ,(package-version package) ,(package-location package)) ,@rest))))) (list (map ->list (package-inputs guile-3.0-latest)) (map ->list (package-native-inputs guile-3.0-latest)) (map ->list (package-propagated-inputs guile-3.0-latest)))) (let* ((inferior (open-inferior %top-builddir #:command "scripts/guix")) (guile (first (lookup-inferior-packages inferior "guile"))) (->list (match-lambda ((label (? inferior-package? package) . rest) `(,label (package ,(inferior-package-name package) ,(inferior-package-version package) ,(inferior-package-location package)) ,@rest)))) (result (list (map ->list (inferior-package-inputs guile)) (map ->list (inferior-package-native-inputs guile)) (map ->list (inferior-package-propagated-inputs guile))))) (close-inferior inferior) result)) (test-equal "inferior-package-search-paths" (package-native-search-paths guile-3.0) (let* ((inferior (open-inferior %top-builddir #:command "scripts/guix")) (guile (first (lookup-inferior-packages inferior "guile"))) (result (inferior-package-native-search-paths guile))) (close-inferior inferior) result)) (test-equal "inferior-eval-with-store" (add-text-to-store %store "foo" "Hello, world!") (let* ((inferior (open-inferior %top-builddir #:command "scripts/guix"))) (inferior-eval-with-store inferior %store '(lambda (store) (add-text-to-store store "foo" "Hello, world!"))))) (test-assert "inferior-eval-with-store, &store-protocol-error" (let* ((inferior (open-inferior %top-builddir #:command "scripts/guix"))) (guard (c ((store-protocol-error? c) (string-contains (store-protocol-error-message c) "invalid character"))) (inferior-eval-with-store inferior %store '(lambda (store) (add-text-to-store store "we|rd/?!@" "uh uh"))) #f))) (test-equal "inferior-eval-with-store, exception" '(the-answer = 42) (let ((inferior (open-inferior %top-builddir #:command "scripts/guix"))) (guard (c ((inferior-exception? c) (close-inferior inferior) (inferior-exception-arguments c))) (inferior-eval-with-store inferior %store '(lambda (store) (throw 'the-answer '= 42)))))) (test-equal "inferior-eval-with-store, not a procedure" 'wrong-type-arg (let ((inferior (open-inferior %top-builddir #:command "scripts/guix"))) (guard (c ((inferior-exception? c) (close-inferior inferior) (car (inferior-exception-arguments c)))) (inferior-eval-with-store inferior %store '(+ 1 2))))) (test-equal "inferior-package-derivation" (map derivation-file-name (list (package-derivation %store %bootstrap-guile "x86_64-linux") (package-derivation %store %bootstrap-guile "armhf-linux"))) (let* ((inferior (open-inferior %top-builddir #:command "scripts/guix")) (packages (inferior-packages inferior)) (guile (find (lambda (package) (string=? (package-name %bootstrap-guile) (inferior-package-name package))) packages))) (map derivation-file-name (list (inferior-package-derivation %store guile "x86_64-linux") (inferior-package-derivation %store guile "armhf-linux"))))) (unless (package-replacement sqlite) (test-skip 1)) (test-equal "inferior-package-replacement" (package-derivation %store (package-replacement sqlite) "x86_64-linux") (let* ((inferior (open-inferior %top-builddir #:command "scripts/guix")) (packages (inferior-packages inferior))) (match (lookup-inferior-packages inferior (package-name sqlite) (package-version sqlite)) ((inferior-sqlite rest ...) (inferior-package-derivation %store (inferior-package-replacement inferior-sqlite) "x86_64-linux"))))) (test-equal "inferior-package->manifest-entry" (manifest-entry->list (package->manifest-entry (first (find-best-packages-by-name "guile" #f)))) (let* ((inferior (open-inferior %top-builddir #:command "scripts/guix")) (guile (first (lookup-inferior-packages inferior "guile"))) (entry (inferior-package->manifest-entry guile))) (close-inferior inferior) (manifest-entry->list entry))) (test-equal "packages->manifest" (map manifest-entry->list (manifest-entries (packages->manifest (find-best-packages-by-name "guile" #f)))) (let* ((inferior (open-inferior %top-builddir #:command "scripts/guix")) (guile (first (lookup-inferior-packages inferior "guile"))) (manifest (packages->manifest (list guile)))) (close-inferior inferior) (map manifest-entry->list (manifest-entries manifest)))) (test-equal "#:error-port stderr" 42 ;; There's a special case in open-bidirectional-pipe for ;; (current-error-port) being stderr, so this test just checks that ;; open-inferior doesn't raise an exception (let ((inferior (open-inferior %top-builddir #:command "scripts/guix" #:error-port (current-error-port)))) (and (inferior? inferior) (inferior-eval '(display "test" (current-error-port)) inferior) (let ((result (inferior-eval '(apply * '(6 7)) inferior))) (close-inferior inferior) result)))) (test-equal "#:error-port pipe" "42" (match (pipe) ((port-to-read-from . port-to-write-to) (setvbuf port-to-read-from 'line) (setvbuf port-to-write-to 'line) (let ((inferior (open-inferior %top-builddir #:command "scripts/guix" #:error-port port-to-write-to))) (and (inferior? inferior) (begin (inferior-eval '(display "42\n" (current-error-port)) inferior) (let loop ((line (read-line port-to-read-from))) (if (string=? line "42") (begin (close-inferior inferior) line) (loop (read-line port-to-read-from)))))))))) (test-end "inferior")