From 67365d79afc7182aefbacf360941f338aea712b6 Mon Sep 17 00:00:00 2001
From: Chris Marusich <cmmarusich@gmail.com>
Date: Sat, 1 Jan 2022 14:17:38 -0800
Subject: [PATCH] gremlin: Mimic ld.so NEEDED deduplication behavior.

Together, these two changes fix the file-needed/recursive test, which was
failing on powerpc64le-linux.  It was not failing on x86_64-linux.

The test failure on powerpc64le-linux was caused by two issues.  First,
file-needed/recursive did not deduplicate entries in the same way as ld.so.
The %guile-executable ELF file contains in its RUNPATH both
"/gnu/store/sipyfs2540b48b2sb9j8ypmybja1dvqb-glibc-2.31/lib" and
"/gnu/store/sipyfs2540b48b2sb9j8ypmybja1dvqb-glibc-2.31/lib/../lib".  Although
ld.so deduplicates the second entry, file-needed/recursive did not.  Second,
the vdso shared library name is "linux-vdso64.so.1", but the test incorrectly
assumed that the vdso shared library would always begin with "linux-vdso.so".

* guix/build/gremlin.scm (file-needed/recursive)[contains-canonical-file?]:
New procedure.  Use it to deduplicate entries that refer to the same file.
* tests/gremlin.scm (file-needed/recursive)[ground-truth]: In addition to
strings that begin with "linux-vdso.so", remove strings that begin with
"linux-vdso64.so".
---
 guix/build/gremlin.scm | 12 +++++++++++-
 tests/gremlin.scm      |  5 ++++-
 2 files changed, 15 insertions(+), 2 deletions(-)

diff --git a/guix/build/gremlin.scm b/guix/build/gremlin.scm
index 2a74d51dd9..e90e59679b 100644
--- a/guix/build/gremlin.scm
+++ b/guix/build/gremlin.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015, 2018, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2022 Chris Marusich <cmmarusich@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -268,6 +269,10 @@ recursively, and the list of .so file names that could not be found.  File
 names are resolved by searching the RUNPATH of the file that NEEDs them.
 
 This is similar to the info returned by the 'ldd' command."
+  (define (contains-canonical-file? file files)
+    (any (lambda (entry)
+           (string=? (canonicalize-path entry) (canonicalize-path file)))
+         files))
   (let loop ((files  (list file))
              (result '())
              (not-found '()))
@@ -292,10 +297,15 @@ This is similar to the info returned by the 'ldd' command."
                                                     (not (libc-library? needed))
                                                     needed))
                                              needed resolved))
+                       ;; Deduplicate entries that refer to the same file.
+                       ;; The actual ld.so tracing behavior is similar and
+                       ;; will de-duplicate entries even if they have
+                       ;; different names but refer to the same file.
                        (needed   (remove (lambda (value)
                                            (or (not value)
                                                ;; XXX: quadratic
-                                               (member value result)))
+                                               (contains-canonical-file?
+                                                value result)))
                                          resolved)))
                   (loop (append rest needed)
                         (append needed result)
diff --git a/tests/gremlin.scm b/tests/gremlin.scm
index 9af899c89a..86757e62b4 100644
--- a/tests/gremlin.scm
+++ b/tests/gremlin.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015, 2018, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2022 Chris Marusich <cmmarusich@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -92,7 +93,9 @@
                (loop result))))))
 
     (define ground-truth
-      (remove (cut string-prefix? "linux-vdso.so" <>)
+      (remove (lambda (entry)
+                (or (string-prefix? "linux-vdso.so" entry)
+                    (string-prefix? "linux-vdso64.so" entry)))
               (read-ldd-output pipe)))
 
     (and (zero? (close-pipe pipe))
-- 
2.26.3

