Merge remote-tracking branch 'origin/master' into core-updates

Change-Id: If336ce5529031f7d45dd78b173d897b4ca2d6ab0

3 files changed, 76 insertions, 6 deletions

diff --git a/tests/lint.scm b/tests/lint.scm
index a52a82237b..87213fcc78 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -1,7 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2012, 2013 Cyril Roelandt <tipecaml@gmail.com>
 ;;; Copyright © 2014, 2015, 2016 Eric Bavier <bavier@member.fsf.org>
-;;; Copyright © 2014-2023 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014-2024 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
 ;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com>
 ;;; Copyright © 2017 Alex Kost <alezost@gmail.com>
@@ -1358,7 +1358,8 @@
          ;; https://archive.softwareheritage.org/api/1/content/
          (content  "{ \"checksums\": {}, \"data_url\": \"xyz\",
                       \"length\": 42 }"))
-    (with-http-server `((200 ,content))
+    (with-http-server `((404 "")                  ;extid
+                        (200 ,content))
       (parameterize ((%swh-base-url (%local-url)))
         (check-archival (dummy-package "x" (source origin)))))))
 
@@ -1378,7 +1379,8 @@
                          \"type\": \"file\",
                          \"name\": \"README\"
                          \"length\": 42 } ]"))
-    (with-http-server `((404 "")                  ;lookup-content
+    (with-http-server `((404 "")                  ;lookup-directory-by-nar-hash
+                        (404 "")                  ;lookup-content
                         (200 ,disarchive)         ;Disarchive database lookup
                         (200 ,directory))         ;lookup-directory
       (mock ((guix download) %disarchive-mirrors (list (%local-url)))
@@ -1397,7 +1399,8 @@
                       \"save_request_date\": \"2014-11-17T22:09:38+01:00\",
                       \"save_request_status\": \"accepted\",
                       \"save_task_status\": \"scheduled\" }")
-         (warnings (with-http-server `((404 "No revision.") ;lookup-revision
+         (warnings (with-http-server `((404 "No extid.") ;lookup-directory-by-nar-hash
+                                       (404 "No revision.") ;lookup-revision
                                        (404 "No origin.")   ;lookup-origin
                                        (200 ,save))         ;save-origin
                      (parameterize ((%swh-base-url (%local-url)))
@@ -1415,7 +1418,27 @@
          ;; https://archive.softwareheritage.org/api/1/revision/
          (revision "{ \"author\": {}, \"parents\": [],
                       \"date\": \"2014-11-17T22:09:38+01:00\" }"))
-    (with-http-server `((200 ,revision))
+    (with-http-server `((404 "No directory.")     ;lookup-directory-by-nar-hash
+                        (200 ,revision))
+      (parameterize ((%swh-base-url (%local-url)))
+        (check-archival (dummy-package "x" (source origin)))))))
+
+(test-equal "archival: nar-sha256 extid available"
+  '()
+  (let* ((origin   (origin
+                     (method git-fetch)
+                     (uri (git-reference
+                           (url "http://example.org/foo.git")
+                           (commit "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa")))
+                     (sha256 (make-bytevector 32))))
+         ;; https://archive.softwareheritage.org/api/1/extid/doc/
+         (extid   "{ \"extid_type\": \"nar-sha256\",
+                     \"extid\": \"1234\",
+                     \"extid_version\": 0,
+                     \"target\": \"swh:1:dir:cabba93\",
+                     \"target_url\": \"boo\"
+                   }"))
+    (with-http-server `((200 ,extid))
       (parameterize ((%swh-base-url (%local-url)))
         (check-archival (dummy-package "x" (source origin)))))))
 
diff --git a/tests/swh.scm b/tests/swh.scm
index a36f951241..e7ced6b50c 100644
--- a/tests/swh.scm
+++ b/tests/swh.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019-2021, 2024 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -18,6 +18,7 @@
 
 (define-module (test-swh)
   #:use-module (guix swh)
+  #:use-module (guix base32)
   #:use-module (guix tests http)
   #:use-module (web response)
   #:use-module (srfi srfi-19)
@@ -56,6 +57,16 @@
        \"length\": 456,
        \"dir_id\": 2 } ]")
 
+(define %external-id
+  "{ \"extid_type\": \"nar-sha256\",
+     \"extid\":
+\"0b56ba94c2b83b8f74e3772887c1109135802eb3e8962b628377987fe97e1e63\",
+     \"version\": 0,
+     \"target\": \"swh:1:dir:84a8b34591712c0a90bab0af604188bcd1fe3153\",
+     \"target_url\":
+\"https://archive.softwareheritage.org/swh:1:dir:84a8b34591712c0a90bab0af604188bcd1fe3153\"
+   }")
+
 (define-syntax-rule (with-json-result str exp ...)
   (with-http-server `((200 ,str))
     (parameterize ((%swh-base-url (%local-url)))
@@ -98,6 +109,14 @@
                  (directory-entry-length entry)))
          (lookup-directory "123"))))
 
+(test-equal "lookup-directory-by-nar-hash"
+  "swh:1:dir:84a8b34591712c0a90bab0af604188bcd1fe3153"
+  (with-json-result %external-id
+    (lookup-directory-by-nar-hash
+     (nix-base32-string->bytevector
+      "0qqygvlpz63phdi2p5p8ncp80dci230qfa3pwds8yfxqqaablmhb")
+     'sha256)))
+
 (test-equal "rate limit reached"
   3000000000
   (let ((too-many (build-response
diff --git a/tests/utils.scm b/tests/utils.scm
index 5664165c85..52f3b58ede 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -5,6 +5,7 @@
 ;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
 ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
 ;;; Copyright © 2023 Foundation Devices, Inc. <hello@foundationdevices.com>
+;;; Copyright © 2024 Herman Rimm <herman@rimm.ee>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -274,6 +275,33 @@ skip these tests."
                      string-reverse)
     (call-with-input-file temp-file get-string-all)))
 
+(test-equal "insert-expression"
+  "(define-public package-1\n  'package)\n
+(define-public package-2\n  'package)\n"
+  (begin
+    (call-with-output-file temp-file
+      (lambda (port)
+        (display "(define-public package-2\n  'package)\n" port)))
+    (insert-expression `((filename . ,temp-file)
+                         (line     . 0)
+                         (column   . 0))
+                       `(define-public package-1 'package))
+    (call-with-input-file temp-file get-string-all)))
+
+(test-equal "find-definition-insertion-location"
+  (list `((filename . ,temp-file) (line . 0) (column . 0))
+        `((filename . ,temp-file) (line . 5) (column . 0))
+        #f)
+  (begin
+    (call-with-output-file temp-file
+      (lambda (port)
+        (display "(define-public package-1\n  'foo)\n\n" port)
+        (display "(define foo 'bar)\n\n" port)
+        (display "(define-public package-2\n  'baz)\n" port)))
+    (map (lambda (term)
+           (find-definition-insertion-location temp-file term))
+         (list 'package 'package-1 'package-2))))
+
 (test-equal "string-distance"
   '(0 1 1 5 5)
   (list