bartronx7/guix
1
0
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2026-01-25 03:55:08 -06:00
Code Issues Projects Releases Packages Wiki Activity Actions
guix/tests/import/nuget.scm
Danny Milosavljevic 811ee1ab9f
import: nuget: Add tests and documentation. 
* guix/import/nuget.scm: Prevent optimizing small functions away completely.
* tests/import/nuget.scm: New file.
* doc/guix.texi (nuget): Document it.
* Makefile.am (SCM_TESTS): Add reference to it.

Fixes: guix/guix#5483
Change-Id: Id58932fe404a11a03e61a91d3b6177b39548f1bc
2026-01-19 19:21:52 +01:00

270 lines
10 KiB
Scheme
Raw Blame History

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2025 Danny Milosavljevic <dannym@friendly-machines.com>
;;;
;;; 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/>.
(define-module (test-nuget)
#:use-module (guix import nuget)
#:use-module (guix tests)
#:use-module (guix tests http)
#:use-module (guix http-client)
#:use-module (json)
#:use-module (semver)
#:use-module (ice-9 match)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-64)
#:use-module (srfi srfi-71)
#:use-module (web uri))
(define (make-versions-json versions)
"Generate a NuGet package versions index JSON string."
(scm->json-string
`((versions . ,(list->vector versions)))))
(define (make-catalog-entry id version description summary home-page license
repo-url repo-commit dependencies)
"Generate a NuGet catalog entry alist."
`((id . ,id)
(version . ,version)
(description . ,description)
(summary . ,summary)
(projectUrl . ,home-page)
(licenseExpression . ,license)
,@(if repo-url
`((repository . ((url . ,repo-url)
(commit . ,repo-commit))))
'())
(dependencyGroups
. ,(list->vector
(if (null? dependencies)
'()
`(((targetFramework . "net6.0")
(dependencies
. ,(list->vector
(map (lambda (dep)
`((id . ,(car dep))
(range . ,(cdr dep))))
dependencies))))))))))
(define (make-registration-index-json catalog-entry)
"Generate a NuGet registration index JSON string."
(scm->json-string
`((items
. #(((items
. #(((catalogEntry . ,catalog-entry))))))))))
(define test-avalonia-versions-json
(make-versions-json '("0.10.0" "0.10.1" "11.0.0" "11.0.1" "11.1.0")))
(define test-avalonia-catalog-entry
(make-catalog-entry "Avalonia" "11.1.0"
"A cross-platform UI framework for .NET"
"Avalonia UI Framework"
"https://avaloniaui.net/"
"MIT"
"https://github.com/AvaloniaUI/Avalonia.git"
"abc123def456"
'(("System.Text.Json" . "[6.0.0, )"))))
(define test-avalonia-index-json
(make-registration-index-json test-avalonia-catalog-entry))
(define test-system-text-json-versions-json
(make-versions-json '("6.0.0" "6.0.1" "7.0.0" "8.0.0")))
(define test-system-text-json-catalog-entry
(make-catalog-entry "System.Text.Json" "8.0.0"
"Provides high-performance JSON APIs"
"JSON library"
"https://dot.net/"
"MIT"
"https://github.com/dotnet/runtime.git"
"def789abc012"
'()))
(define test-system-text-json-index-json
(make-registration-index-json test-system-text-json-catalog-entry))
(define test-package-no-repo-versions-json
(make-versions-json '("1.0.0")))
(define test-package-no-repo-catalog-entry
(make-catalog-entry "TestPackage" "1.0.0"
"Test package without repository"
#f
"https://example.com/"
"MIT"
#f #f
'()))
(define test-package-no-repo-index-json
(make-registration-index-json test-package-no-repo-catalog-entry))
(define-syntax-rule (with-nuget responses body ...)
(with-http-server responses
(parameterize ((%nuget-v3-package-versions-url
(%local-url #:path "/versions/"))
(%nuget-v3-registration-url
(%local-url #:path "/registration/"))
(%nuget-symbol-packages-url
(%local-url #:path "/symbols/")))
body ...)))
(test-begin "nuget")
(test-assert "nuget->guix-package"
;; Replace network resources with sample data.
(with-nuget `(("/versions/avalonia/index.json" 200 ,test-avalonia-versions-json)
("/registration/avalonia/index.json" 200 ,test-avalonia-index-json))
(let ((package-sexp dependencies (nuget->guix-package "Avalonia")))
(match package-sexp
(`(package
(name "dotnet-avalonia")
(version "11.1.0")
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/AvaloniaUI/Avalonia.git")
(commit "abc123def456")))
(file-name (git-file-name name version))
(sha256 (base32 ,(? string?)))))
(build-system mono-build-system)
(inputs (list dotnet-system-text-json))
(home-page "https://avaloniaui.net/")
(synopsis ,(? string?))
(description ,(? string?))
(license ,?))
(equal? dependencies '("System.Text.Json")))
(x
(pk 'fail x #f))))))
(test-assert "nuget-name->guix-name"
(and (string=? ((@@ (guix import nuget) nuget-name->guix-name) "Avalonia")
"dotnet-avalonia")
(string=? ((@@ (guix import nuget) nuget-name->guix-name) "System.Text.Json")
"dotnet-system-text-json")))
(test-assert "nuget-recursive-import"
;; Replace network resources with sample data.
;; recursive-import returns a list of package s-expressions in topological order.
(with-nuget `(("/versions/avalonia/index.json" 200 ,test-avalonia-versions-json)
("/registration/avalonia/index.json" 200 ,test-avalonia-index-json)
("/versions/system.text.json/index.json" 200
,test-system-text-json-versions-json)
("/registration/system.text.json/index.json" 200
,test-system-text-json-index-json))
(let ((packages (nuget-recursive-import "Avalonia")))
(match packages
((first second)
;; Check that we got two packages
(and (match first
(`(package (name ,name1) . ,_)
(or (string=? name1 "dotnet-system-text-json")
(string=? name1 "dotnet-avalonia"))))
(match second
(`(package (name ,name2) . ,_)
(or (string=? name2 "dotnet-system-text-json")
(string=? name2 "dotnet-avalonia"))))))
(x
(pk 'fail-recursive-count x #f))))))
(test-assert "parse-nuget-range->primitives: exact version"
(let ((result ((@@ (guix import nuget) parse-nuget-range->primitives) "[1.0.0]")))
(match result
(((('= slice)))
(equal? slice '(1 0 0 0 () ())))
(_ #f))))
(test-assert "parse-nuget-range->primitives: minimum version"
(let ((result ((@@ (guix import nuget) parse-nuget-range->primitives) "1.0.0")))
(match result
((('>= slice))
(equal? slice '(1 0 0 0 () ())))
(_ #f))))
(test-assert "parse-nuget-range->primitives: range with brackets"
(let ((result ((@@ (guix import nuget) parse-nuget-range->primitives) "[1.0.0,2.0.0]")))
(match result
((('>= sv1) ('<= sv2))
(and (semver? sv1)
(semver? sv2)
(string=? (semver->string sv1) "1.0.0")
(string=? (semver->string sv2) "2.0.0")))
(_ #f))))
(test-assert "parse-nuget-range->primitives: range with parens"
(let ((result ((@@ (guix import nuget) parse-nuget-range->primitives) "(1.0.0,2.0.0)")))
(match result
((('> sv1) ('< sv2))
(and (semver? sv1)
(semver? sv2)
(string=? (semver->string sv1) "1.0.0")
(string=? (semver->string sv2) "2.0.0")))
(_ #f))))
(test-assert "parse-nuget-range->primitives: open-ended range"
(let ((result ((@@ (guix import nuget) parse-nuget-range->primitives) "[1.0.0, )")))
(match result
((('>= sv))
(and (semver? sv)
(string=? (semver->string sv) "1.0.0")))
(_ #f))))
(test-assert "nuget-find-best-version-for-range: stable version"
;; Test that it finds the highest stable version matching a range
(with-nuget `(("/versions/avalonia/index.json" 200 ,test-avalonia-versions-json))
(let ((version ((@@ (guix import nuget) nuget-find-best-version-for-range)
"Avalonia" "[11.0.0,)")))
(string=? version "11.1.0"))))
(test-assert "nuget-find-best-version-for-range: closed range"
(with-nuget `(("/versions/avalonia/index.json" 200 ,test-avalonia-versions-json))
(let ((version ((@@ (guix import nuget) nuget-find-best-version-for-range)
"Avalonia" "[11.0.0,12.0.0]")))
(string=? version "11.1.0"))))
(test-assert "nuget-fetch-catalog-entry: finds specific version"
(with-nuget `(("/registration/avalonia/index.json" 200 ,test-avalonia-index-json))
(let ((entry ((@@ (guix import nuget) nuget-fetch-catalog-entry)
"Avalonia" "11.1.0")))
(and entry
(string=? (assoc-ref entry "version") "11.1.0")
(string=? (assoc-ref entry "id") "Avalonia")))))
(test-assert "nuget->guix-package: package without repository"
;; Test package with no repository info (source should have FIXME)
(with-nuget `(("/versions/testpackage/index.json" 200
,test-package-no-repo-versions-json)
("/registration/testpackage/index.json" 200
,test-package-no-repo-index-json)
("/symbols/testpackage.1.0.0.snupkg" 404 ""))
(let ((package-sexp dependencies (nuget->guix-package "TestPackage")))
(match package-sexp
(`(package
(name "dotnet-testpackage")
(version "1.0.0")
(source
(origin
(method url-fetch)
(uri "FIXME: No source URL found.")
. ,_))
. ,_)
(equal? dependencies '()))
(x
(pk 'fail-no-repo x #f))))))
(test-end "nuget")
Reference in a new issue View git blame Copy permalink