[bug#62202] [PATCH v4 6/6] tests: juliahub: Add unit tests for (guix import juliahub).

[Nicolas Graves via Guix-patches via <guix-patches@gnu.org>]

* tests/juliahub.scm : Add unit tests juliahub-redirect,
julia-general-registry-parsing, juliahub-fetch.

Change-Id: Ief5133b49a15d0bfc72bb357321126d296ba2802
---
 tests/juliahub.scm | 185 +++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 185 insertions(+)
 create mode 100644 tests/juliahub.scm

diff --git a/tests/juliahub.scm b/tests/juliahub.scm
new file mode 100644
index 0000000000..21fdc3a4eb
--- /dev/null
+++ b/tests/juliahub.scm
@@ -0,0 +1,185 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2024 Nicolas Graves <ngraves@ngraves.fr>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Summary
+;; Tests for guix/import/juliahub.scm
+
+(define-module (tests-import-juliahub)
+  #:use-module (guix base32)
+  #:use-module (json)
+  #:use-module (guix import juliahub)
+  #:use-module (guix import utils)
+  #:use-module ((guix utils) #:select (call-with-temporary-directory))
+  #:use-module (guix tests)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-19)
+  #:use-module (srfi srfi-64)
+  #:use-module (srfi srfi-71)
+  #:use-module (web response))
+
+;; XXX: Copied from tests/go.scm
+
+(define (mock-http-fetch testcase)
+  (lambda (url . rest)
+    (let ((body (assoc-ref testcase url)))
+      (if body
+          (open-input-string body)
+          (error "mocked http-fetch Unexpected URL: " url)))))
+
+(define (mock-http-get testcase)
+  (lambda (url . rest)
+    (let ((body (assoc-ref testcase url))
+          (response-header
+             (build-response
+                #:version '(1 . 1)
+                #:code 200
+                #:reason-phrase "Ok"
+                #:headers `(
+                            (content-type text/html (charset . "utf-8"))
+                            (date . ,(make-date 0 10 58 12 6 3 2021 0))
+                            (transfer-encoding (chunked)))
+                #:port #f
+                #:validate-headers? #t)))
+      (if body
+          (values response-header body)
+          (error "mocked http-get Unexpected URL: " url)))))
+
+;; Mock an empty directory by replacing hash.
+(define* (mock-git->origin repo-url ref #:key (ref->commit #f))
+  (let* ((version (if (pair? ref)
+                      (cdr ref)
+                      #f))
+         (vcommit (match ref->commit
+                    (#t    commit)
+                    (#f    version)
+                    ((? procedure?) (ref->commit version))
+                    (_     #f))))
+    `(origin
+       (method git-fetch)
+       (uri (git-reference
+             (url ,(and (not (eq? repo-url 'null)) repo-url))
+             (commit ,vcommit)))
+       (file-name (git-file-name name version))
+       (sha256
+        (base32
+         "0sjjj9z1dhilhpc8pq4154czrb79z9cm044jvn75kxcjv6v5l2m5")))))
+
+;; Fixtures.
+
+(define fixture-pkg.json
+  (scm->json-string
+   `(("hosted_uri" . "https://git.savannah.gnu.org/cgit/MyPackage.git")
+     ("installable" . "missing")
+     ("license" . "GPL-3.0")
+     ("tags" . #("my-tag"))
+     ("uuid" . "aaaaaaaa-aaaa-aaaa-aaaa-aaaaaaaaaaaa")
+     ("url" . "https://git.savannah.gnu.org/cgit/MyPackage.git")
+     ("contributors" . #((("url" . "https://github.com/me") ("type" . "User") ("contributions" . 1) ("name" . "me"))))
+     ("success" . #t)
+     ("reversedeps" . #())
+     ("pkgeval"
+      ("report_url" . "https://github.com/JuliaCI/NanosoldierReports/blob/master/pkgeval/by_date/2024-02/01/report.md")
+      ("version" ("minor" . 18) ("patch" . 1) ("build" . #()) ("prerelease" . #()) ("major" . 1))
+      ("reason" . "time_limit")
+      ("log_url" . "https://s3.amazonaws.com/julialang-reports/nanosoldier/pkgeval/by_date/2024-02/01/MyPackage.jl.primary.log")
+      ("status" . "fail")
+      ("duration" . 0))
+     ("stargazers_count" . 0)
+     ("deps" . #((("slug" . "3FQLY")
+                  ("registry" . "")
+                  ("versions" . #("0.0.0" "1.6.0-1"))
+                  ("uuid" . "de0858da-6303-5e67-8744-51eddeeeb8d7")
+                  ("name" . "Printf")
+                  ("direct" . #t))
+                 (("slug" . "SIw1t")
+                  ("registry" . "")
+                  ("versions" . #("*" "0.0.0" "1"))
+                  ("uuid" . "cf7118a7-6976-5b1a-9a39-7adc72f591a4")
+                  ("name" . "UUIDs")
+                  ("direct" . #f))
+                 (("slug" . "THl1k")
+                  ("registry" . "General")
+                  ("versions" . #("0.7" "1" "1-1.10" "1.0-1.5" "1.3.0-1" "1.6.0-1" "1.9.0-1" "1.9.4-1"))
+                  ("uuid" . "1222c4b2-2114-5bfd-aeef-88e4692bbb3e")
+                  ("name" . "julia")
+                  ("direct" . #f))
+                 (("slug" . "THl1k")
+                  ("registry" . "General")
+                  ("versions" . #("1.6.0-1"))
+                  ("uuid" . "1222c4b2-2114-5bfd-aeef-88e4692bbb3e")
+                  ("name" . "julia")
+                  ("direct" . #t))))
+     ("description" . "My description")
+     ("version" . "1.0.0")
+     ("documenter_errored" . "missing")
+     ("slug" . "MySlg")
+     ("owner" . "me")
+     ("release_date" . "Feb 2024")
+     ("name" . "MyPackage.jl")
+     ("readme" . "My readme")
+     ("homepage" . "https://git.savannah.gnu.org/cgit/MyPackage.git")
+     ("doctype" . "hosted")
+     ("license_url" . "/docs/MyPackage/MySlg/1.0.0/_packagesource/LICENSE.md"))))
+
+(define fixtures-juliahub-check-test
+  `(("https://docs.juliahub.com/MyPackage/" . "\
+<head>
+<meta http-equiv=\"refresh\" content=\"0; url=MySlg/1.0.0\" />
+</head>")
+    ("https://raw.githubusercontent.com/JuliaRegistries/General/master\
+/M/MyPackage/Package.toml" . "\
+name = \"MyPackage\"
+uuid = \"aaaaaaaa-aaaa-aaaa-aaaa-aaaaaaaaaaaa\"
+repo = \"https://git.savannah.gnu.org/cgit/MyPackage.git\"
+")
+    ("https://docs.juliahub.com/MyPackage/MySlg/1.0.0/pkg.json" . ,fixture-pkg.json)))
+
+(test-begin "juliahub")
+
+;;; Unit tests for (guix import juliahub)
+
+(test-equal "juliahub-redirect"
+  "https://docs.juliahub.com/MyPackage/MySlg/1.0.0/"
+  (mock ((web client) http-get
+         (mock-http-get fixtures-juliahub-check-test))
+        (mock ((guix http-client) http-fetch
+               (mock-http-fetch fixtures-juliahub-check-test))
+              ((@@ (guix import juliahub) juliahub-url) "MyPackage"))))
+
+(test-equal "julia-general-registry-parsing"
+  "https://git.savannah.gnu.org/cgit/MyPackage.git"
+  (mock ((web client) http-get
+         (mock-http-get fixtures-juliahub-check-test))
+        (mock ((guix http-client) http-fetch
+               (mock-http-fetch fixtures-juliahub-check-test))
+              (assoc-ref
+               ((@@ (guix import juliahub) ini-fetch)
+                ((@@ (guix import juliahub) general-url) "MyPackage" "Package.toml"))
+               'repo))))
+
+(test-equal "juliahub-fetch"
+  #t
+  (mock ((web client) http-get
+         (mock-http-get fixtures-juliahub-check-test))
+        (mock ((guix http-client) http-fetch
+               (mock-http-fetch fixtures-juliahub-check-test))
+              (mock ((guix import utils) git->origin mock-git->origin)
+                    ((@@ (guix import juliahub) juliahub-package?)
+                     ((@@ (guix import juliahub) juliahub-fetch) "MyPackage"))))))
+
+(test-end "juliahub")
-- 
2.41.0