projects/guix·blob master · refs

270 lines · 10.4 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2025 Danny Milosavljevic <[email protected]>
3;;;
4;;; This file is part of GNU Guix.
5;;;
6;;; GNU Guix is free software; you can redistribute it and/or modify it
7;;; under the terms of the GNU General Public License as published by
8;;; the Free Software Foundation; either version 3 of the License, or (at
9;;; your option) any later version.
10;;;
11;;; GNU Guix is distributed in the hope that it will be useful, but
12;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14;;; GNU General Public License for more details.
15;;;
16;;; You should have received a copy of the GNU General Public License
17;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
18
19(define-module (test-nuget)
20 #:use-module (guix import nuget)
21 #:use-module (guix tests)
22 #:use-module (guix tests http)
23 #:use-module (guix http-client)
24 #:use-module (json)
25 #:use-module (semver)
26 #:use-module (ice-9 match)
27 #:use-module (srfi srfi-34)
28 #:use-module (srfi srfi-64)
29 #:use-module (srfi srfi-71)
30 #:use-module (web uri))
31
32(define (make-versions-json versions)
33 "Generate a NuGet package versions index JSON string."
34 (scm->json-string
35 `((versions . ,(list->vector versions)))))
36
37(define (make-catalog-entry id version description summary home-page license
38 repo-url repo-commit dependencies)
39 "Generate a NuGet catalog entry alist."
40 `((id . ,id)
41 (version . ,version)
42 (description . ,description)
43 (summary . ,summary)
44 (projectUrl . ,home-page)
45 (licenseExpression . ,license)
46 ,@(if repo-url
47 `((repository . ((url . ,repo-url)
48 (commit . ,repo-commit))))
49 '())
50 (dependencyGroups
51 . ,(list->vector
52 (if (null? dependencies)
53 '()
54 `(((targetFramework . "net6.0")
55 (dependencies
56 . ,(list->vector
57 (map (lambda (dep)
58 `((id . ,(car dep))
59 (range . ,(cdr dep))))
60 dependencies))))))))))
61
62(define (make-registration-index-json catalog-entry)
63 "Generate a NuGet registration index JSON string."
64 (scm->json-string
65 `((items
66 . #(((items
67 . #(((catalogEntry . ,catalog-entry))))))))))
68
69(define test-avalonia-versions-json
70 (make-versions-json '("0.10.0" "0.10.1" "11.0.0" "11.0.1" "11.1.0")))
71
72(define test-avalonia-catalog-entry
73 (make-catalog-entry "Avalonia" "11.1.0"
74 "A cross-platform UI framework for .NET"
75 "Avalonia UI Framework"
76 "https://avaloniaui.net/"
77 "MIT"
78 "https://github.com/AvaloniaUI/Avalonia.git"
79 "abc123def456"
80 '(("System.Text.Json" . "[6.0.0, )"))))
81
82(define test-avalonia-index-json
83 (make-registration-index-json test-avalonia-catalog-entry))
84
85(define test-system-text-json-versions-json
86 (make-versions-json '("6.0.0" "6.0.1" "7.0.0" "8.0.0")))
87
88(define test-system-text-json-catalog-entry
89 (make-catalog-entry "System.Text.Json" "8.0.0"
90 "Provides high-performance JSON APIs"
91 "JSON library"
92 "https://dot.net/"
93 "MIT"
94 "https://github.com/dotnet/runtime.git"
95 "def789abc012"
96 '()))
97
98(define test-system-text-json-index-json
99 (make-registration-index-json test-system-text-json-catalog-entry))
100
101(define test-package-no-repo-versions-json
102 (make-versions-json '("1.0.0")))
103
104(define test-package-no-repo-catalog-entry
105 (make-catalog-entry "TestPackage" "1.0.0"
106 "Test package without repository"
107 #f
108 "https://example.com/"
109 "MIT"
110 #f #f
111 '()))
112
113(define test-package-no-repo-index-json
114 (make-registration-index-json test-package-no-repo-catalog-entry))
115
116(define-syntax-rule (with-nuget responses body ...)
117 (with-http-server responses
118 (parameterize ((%nuget-v3-package-versions-url
119 (%local-url #:path "/versions/"))
120 (%nuget-v3-registration-url
121 (%local-url #:path "/registration/"))
122 (%nuget-symbol-packages-url
123 (%local-url #:path "/symbols/")))
124 body ...)))
125
126(test-begin "nuget")
127
128(test-assert "nuget->guix-package"
129 ;; Replace network resources with sample data.
130 (with-nuget `(("/versions/avalonia/index.json" 200 ,test-avalonia-versions-json)
131 ("/registration/avalonia/index.json" 200 ,test-avalonia-index-json))
132 (let ((package-sexp dependencies (nuget->guix-package "Avalonia")))
133 (match package-sexp
134 (`(package
135 (name "dotnet-avalonia")
136 (version "11.1.0")
137 (source
138 (origin
139 (method git-fetch)
140 (uri (git-reference
141 (url "https://github.com/AvaloniaUI/Avalonia.git")
142 (commit "abc123def456")))
143 (file-name (git-file-name name version))
144 (sha256 (base32 ,(? string?)))))
145 (build-system mono-build-system)
146 (inputs (list dotnet-system-text-json))
147 (home-page "https://avaloniaui.net/")
148 (synopsis ,(? string?))
149 (description ,(? string?))
150 (license ,?))
151 (equal? dependencies '("System.Text.Json")))
152 (x
153 (pk 'fail x #f))))))
154
155(test-assert "nuget-name->guix-name"
156 (and (string=? ((@@ (guix import nuget) nuget-name->guix-name) "Avalonia")
157 "dotnet-avalonia")
158 (string=? ((@@ (guix import nuget) nuget-name->guix-name) "System.Text.Json")
159 "dotnet-system-text-json")))
160
161(test-assert "nuget-recursive-import"
162 ;; Replace network resources with sample data.
163 ;; recursive-import returns a list of package s-expressions in topological order.
164 (with-nuget `(("/versions/avalonia/index.json" 200 ,test-avalonia-versions-json)
165 ("/registration/avalonia/index.json" 200 ,test-avalonia-index-json)
166 ("/versions/system.text.json/index.json" 200
167 ,test-system-text-json-versions-json)
168 ("/registration/system.text.json/index.json" 200
169 ,test-system-text-json-index-json))
170 (let ((packages (nuget-recursive-import "Avalonia")))
171 (match packages
172 ((first second)
173 ;; Check that we got two packages
174 (and (match first
175 (`(package (name ,name1) . ,_)
176 (or (string=? name1 "dotnet-system-text-json")
177 (string=? name1 "dotnet-avalonia"))))
178 (match second
179 (`(package (name ,name2) . ,_)
180 (or (string=? name2 "dotnet-system-text-json")
181 (string=? name2 "dotnet-avalonia"))))))
182 (x
183 (pk 'fail-recursive-count x #f))))))
184
185(test-assert "parse-nuget-range->primitives: exact version"
186 (let ((result ((@@ (guix import nuget) parse-nuget-range->primitives) "[1.0.0]")))
187 (match result
188 (((('= slice)))
189 (equal? slice '(1 0 0 0 () ())))
190 (_ #f))))
191
192(test-assert "parse-nuget-range->primitives: minimum version"
193 (let ((result ((@@ (guix import nuget) parse-nuget-range->primitives) "1.0.0")))
194 (match result
195 ((('>= slice))
196 (equal? slice '(1 0 0 0 () ())))
197 (_ #f))))
198
199(test-assert "parse-nuget-range->primitives: range with brackets"
200 (let ((result ((@@ (guix import nuget) parse-nuget-range->primitives) "[1.0.0,2.0.0]")))
201 (match result
202 ((('>= sv1) ('<= sv2))
203 (and (semver? sv1)
204 (semver? sv2)
205 (string=? (semver->string sv1) "1.0.0")
206 (string=? (semver->string sv2) "2.0.0")))
207 (_ #f))))
208
209(test-assert "parse-nuget-range->primitives: range with parens"
210 (let ((result ((@@ (guix import nuget) parse-nuget-range->primitives) "(1.0.0,2.0.0)")))
211 (match result
212 ((('> sv1) ('< sv2))
213 (and (semver? sv1)
214 (semver? sv2)
215 (string=? (semver->string sv1) "1.0.0")
216 (string=? (semver->string sv2) "2.0.0")))
217 (_ #f))))
218
219(test-assert "parse-nuget-range->primitives: open-ended range"
220 (let ((result ((@@ (guix import nuget) parse-nuget-range->primitives) "[1.0.0, )")))
221 (match result
222 ((('>= sv))
223 (and (semver? sv)
224 (string=? (semver->string sv) "1.0.0")))
225 (_ #f))))
226
227(test-assert "nuget-find-best-version-for-range: stable version"
228 ;; Test that it finds the highest stable version matching a range
229 (with-nuget `(("/versions/avalonia/index.json" 200 ,test-avalonia-versions-json))
230 (let ((version ((@@ (guix import nuget) nuget-find-best-version-for-range)
231 "Avalonia" "[11.0.0,)")))
232 (string=? version "11.1.0"))))
233
234(test-assert "nuget-find-best-version-for-range: closed range"
235 (with-nuget `(("/versions/avalonia/index.json" 200 ,test-avalonia-versions-json))
236 (let ((version ((@@ (guix import nuget) nuget-find-best-version-for-range)
237 "Avalonia" "[11.0.0,12.0.0]")))
238 (string=? version "11.1.0"))))
239
240(test-assert "nuget-fetch-catalog-entry: finds specific version"
241 (with-nuget `(("/registration/avalonia/index.json" 200 ,test-avalonia-index-json))
242 (let ((entry ((@@ (guix import nuget) nuget-fetch-catalog-entry)
243 "Avalonia" "11.1.0")))
244 (and entry
245 (string=? (assoc-ref entry "version") "11.1.0")
246 (string=? (assoc-ref entry "id") "Avalonia")))))
247
248(test-assert "nuget->guix-package: package without repository"
249 ;; Test package with no repository info (source should have FIXME)
250 (with-nuget `(("/versions/testpackage/index.json" 200
251 ,test-package-no-repo-versions-json)
252 ("/registration/testpackage/index.json" 200
253 ,test-package-no-repo-index-json)
254 ("/symbols/testpackage.1.0.0.snupkg" 404 ""))
255 (let ((package-sexp dependencies (nuget->guix-package "TestPackage")))
256 (match package-sexp
257 (`(package
258 (name "dotnet-testpackage")
259 (version "1.0.0")
260 (source
261 (origin
262 (method url-fetch)
263 (uri "FIXME: No source URL found.")
264 . ,_))
265 . ,_)
266 (equal? dependencies '()))
267 (x
268 (pk 'fail-no-repo x #f))))))
269
270(test-end "nuget")