From b178fc236908ad2da86734ea8e01abd3ff8981da Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 17 Apr 2018 13:38:12 +0200 Subject: gremlin: Add 'strip-runpath'. * guix/build/gremlin.scm (strip-runpath): New procedure. * tests/gremlin.scm (c-compiler): New variable. ("strip-runpath"): New test. --- tests/gremlin.scm | 35 ++++++++++++++++++++++++++++++++++- 1 file changed, 34 insertions(+), 1 deletion(-) (limited to 'tests') diff --git a/tests/gremlin.scm b/tests/gremlin.scm index 2885554967..1b47d5c384 100644 --- a/tests/gremlin.scm +++ b/tests/gremlin.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015 Ludovic Courtès +;;; Copyright © 2015, 2018 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -18,12 +18,14 @@ (define-module (test-gremlin) #:use-module (guix elf) + #:use-module ((guix utils) #:select (call-with-temporary-directory)) #:use-module (guix build utils) #:use-module (guix build gremlin) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-64) #:use-module (rnrs io ports) + #:use-module (ice-9 popen) #:use-module (ice-9 match)) (define %guile-executable @@ -37,6 +39,9 @@ (define read-elf (compose parse-elf get-bytevector-all)) +(define c-compiler + (or (which "gcc") (which "cc") (which "g++"))) + (test-begin "gremlin") @@ -63,4 +68,32 @@ "../${ORIGIN}/bar/$ORIGIN/baz" "ORIGIN/foo"))) +(unless c-compiler + (test-skip 1)) +(test-equal "strip-runpath" + "hello\n" + (call-with-temporary-directory + (lambda (directory) + (with-directory-excursion directory + (call-with-output-file "t.c" + (lambda (port) + (display "int main () { puts(\"hello\"); }" port))) + (invoke c-compiler "t.c" + "-Wl,-rpath=/foo" "-Wl,-rpath=/bar") + (let* ((dyninfo (elf-dynamic-info + (parse-elf (call-with-input-file "a.out" + get-bytevector-all)))) + (old (elf-dynamic-info-runpath dyninfo)) + (new (strip-runpath "a.out")) + (new* (strip-runpath "a.out"))) + (validate-needed-in-runpath "a.out") + (and (member "/foo" old) (member "/bar" old) + (not (member "/foo" new)) + (not (member "/bar" new)) + (equal? new* new) + (let* ((pipe (open-input-pipe "./a.out")) + (str (get-string-all pipe))) + (close-pipe pipe) + str))))))) + (test-end "gremlin") -- cgit v1.2.3 From 8c7bebd6ea99f0ee4fb46a48ecb1883754c8cdde Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 26 Jul 2018 22:59:49 +0200 Subject: gexp: Remove backward compatibility hack for 'imported-files'. * guix/gexp.scm (gexp->derivation): Remove #:import-creates-derivation?. (imported-files): Remove #:derivation? and adjust callers. (imported-modules), compiled-modules): Likewise. * guix/packages.scm (patch-and-repack): Adjust 'gexp->derivation' call. --- guix/gexp.scm | 28 ++++------------------------ guix/packages.scm | 3 --- tests/gexp.scm | 6 +++--- 3 files changed, 7 insertions(+), 30 deletions(-) (limited to 'tests') diff --git a/guix/gexp.scm b/guix/gexp.scm index ffc976d61b..f358102782 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -601,12 +601,6 @@ names and file names suitable for the #:allowed-references argument to allowed-references disallowed-references leaked-env-vars local-build? (substitutable? #t) - - ;; TODO: This parameter is transitional; it's here - ;; to avoid a full rebuild. Remove it on the next - ;; rebuild cycle. - import-creates-derivation? - deprecation-warnings (script-name (string-append name "-builder"))) "Return a derivation NAME that runs EXP (a gexp) with GUILE-FOR-BUILD (a @@ -701,8 +695,6 @@ The other arguments are as for 'derivation'." extensions)) (modules (if (pair? %modules) (imported-modules %modules - #:derivation? - import-creates-derivation? #:system system #:module-path module-path #:guile guile-for-build @@ -711,8 +703,6 @@ The other arguments are as for 'derivation'." (return #f))) (compiled (if (pair? %modules) (compiled-modules %modules - #:derivation? - import-creates-derivation? #:system system #:module-path module-path #:extensions extensions @@ -1141,11 +1131,6 @@ to the source files instead of copying them." (define* (imported-files files #:key (name "file-import") - - ;; TODO: Remove this parameter on the next rebuild - ;; cycle. - (derivation? #f) - ;; The following parameters make sense when creating ;; an actual derivation. (system (%current-system)) @@ -1157,11 +1142,10 @@ file-like objects and not local file names.) FILES must be a list of (FINAL-PATH . FILE) pairs. Each FILE is mapped to FINAL-PATH in the resulting store path. FILE can be either a file name, or a file-like object, as returned by 'local-file' for example." - (if (or derivation? - (any (match-lambda - ((_ . (? struct? source)) #t) - (_ #f)) - files)) + (if (any (match-lambda + ((_ . (? struct? source)) #t) + (_ #f)) + files) (imported-files/derivation files #:name name #:symlink? derivation? #:system system #:guile guile @@ -1171,7 +1155,6 @@ as returned by 'local-file' for example." (define* (imported-modules modules #:key (name "module-import") - (derivation? #f) ;TODO: remove on next rebuild (system (%current-system)) (guile (%guile-for-build)) (module-path %load-path) @@ -1196,14 +1179,12 @@ last one is created from the given object." (cons f (search-path* module-path f))))) modules))) (imported-files files #:name name - #:derivation? derivation? #:system system #:guile guile #:deprecation-warnings deprecation-warnings))) (define* (compiled-modules modules #:key (name "module-import-compiled") - (derivation? #f) ;TODO: remove on next rebuild (system (%current-system)) (guile (%guile-for-build)) (module-path %load-path) @@ -1223,7 +1204,6 @@ they can refer to each other." (not (equal? module-path %load-path)))) (mlet %store-monad ((modules (imported-modules modules - #:derivation? derivation? #:system system #:guile guile #:module-path diff --git a/guix/packages.scm b/guix/packages.scm index 01045ded07..eab0b3404c 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -641,9 +641,6 @@ specifies modules in scope when evaluating SNIPPET." (let ((name (tarxz-name original-file-name))) (gexp->derivation name build - ;; TODO: Remove this on the next rebuild cycle. - #:import-creates-derivation? #t - #:graft? #f #:system system #:deprecation-warnings #t ;to avoid a rebuild diff --git a/tests/gexp.scm b/tests/gexp.scm index b22e635805..a0ed34aa6d 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -654,11 +654,11 @@ (drv (imported-files files))) (define (file=? file1 file2) ;; Assume deduplication is in place. - (= (stat:ino (lstat file1)) - (stat:ino (lstat file2)))) + (= (stat:ino (stat file1)) + (stat:ino (stat file2)))) (mbegin %store-monad - (built-derivations (list drv)) + (built-derivations (list (pk 'drv drv))) (mlet %store-monad ((dir -> (derivation->output-path drv)) (plain* (text-file "foo" "bar!")) (q-scm* (interned-file q-scm "c"))) -- cgit v1.2.3