Commit | Line | Data |
---|---|---|
e1248602 RW |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net> | |
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-cran) | |
20 | #:use-module (guix import cran) | |
21 | #:use-module (guix tests) | |
22 | #:use-module (srfi srfi-64) | |
23 | #:use-module (ice-9 match)) | |
24 | ||
25 | (define sxml | |
26 | '(*TOP* (xhtml:html | |
27 | (xhtml:head | |
28 | (xhtml:title "CRAN - Package my-example-sxml")) | |
29 | (xhtml:body | |
30 | (xhtml:h2 "my-example-sxml: Short description") | |
31 | (xhtml:p "Long description") | |
32 | (xhtml:table | |
33 | (@ (summary "Package my-example-sxml summary")) | |
34 | (xhtml:tr | |
35 | (xhtml:td "Version:") | |
36 | (xhtml:td "1.2.3")) | |
37 | (xhtml:tr | |
38 | (xhtml:td "Depends:") | |
39 | (xhtml:td "R (>= 3.1.0)")) | |
40 | (xhtml:tr | |
41 | (xhtml:td "SystemRequirements:") | |
42 | (xhtml:td "cairo (>= 1.2 http://www.cairographics.org/)")) | |
43 | (xhtml:tr | |
44 | (xhtml:td "Imports:") | |
45 | (xhtml:td | |
46 | (xhtml:a (@ (href "../scales/index.html")) | |
47 | "scales") | |
48 | " (>= 0.2.3), " | |
49 | (xhtml:a (@ (href "../proto/index.html")) | |
50 | "proto") | |
51 | ", " | |
52 | (xhtml:a (@ (href "../Rcpp/index.html")) "Rcpp") | |
53 | " (>= 0.11.0)")) | |
54 | (xhtml:tr | |
55 | (xhtml:td "Suggests:") | |
56 | (xhtml:td | |
57 | (xhtml:a (@ (href "../some/index.html")) | |
58 | "some") | |
59 | ", " | |
60 | (xhtml:a (@ (href "../suggestions/index.html")) | |
61 | "suggestions"))) | |
62 | (xhtml:tr | |
63 | (xhtml:td "License:") | |
64 | (xhtml:td | |
65 | (xhtml:a (@ (href "../../licenses/MIT")) "MIT"))) | |
66 | (xhtml:tr | |
67 | (xhtml:td "URL:") | |
68 | (xhtml:td | |
69 | (xhtml:a (@ (href "http://gnu.org/s/my-example-sxml")) | |
70 | "http://gnu.org/s/my-example-sxml") | |
71 | ", " | |
72 | (xhtml:a (@ (href "http://alternative/home/page")) | |
73 | "http://alternative/home/page")))) | |
74 | (xhtml:h4 "Downloads:") | |
75 | (xhtml:table | |
76 | (@ (summary "Package my-example-sxml downloads")) | |
77 | (xhtml:tr | |
78 | (xhtml:td " Reference manual: ") | |
79 | (xhtml:td | |
80 | (xhtml:a (@ (href "my-example-sxml.pdf")) | |
81 | " my-example-sxml.pdf "))) | |
82 | (xhtml:tr | |
83 | (xhtml:td " Package source: ") | |
84 | (xhtml:td | |
85 | (xhtml:a | |
86 | (@ (href "../../../src/contrib/my-example-sxml_1.2.3.tar.gz")) | |
87 | " my-example-sxml_1.2.3.tar.gz ")))) | |
88 | (xhtml:h4 "Reverse dependencies:") | |
89 | (xhtml:table | |
90 | (@ (summary "Package my-example-sxml reverse dependencies")) | |
91 | (xhtml:tr | |
92 | (xhtml:td "Reverse depends:") | |
93 | (xhtml:td "Too many.")) | |
94 | (xhtml:tr | |
95 | (xhtml:td "Reverse imports:") | |
96 | (xhtml:td "Likewise.")) | |
97 | (xhtml:tr | |
98 | (xhtml:td "Reverse suggests:") | |
99 | (xhtml:td "Uncountable."))))))) | |
100 | ||
101 | (define simple-table | |
102 | '(xhtml:table | |
103 | (xhtml:tr | |
104 | (xhtml:td "Numbers") | |
105 | (xhtml:td "123")) | |
106 | (xhtml:tr | |
107 | (@ (class "whatever")) | |
108 | (xhtml:td (@ (class "unimportant")) "Letters") | |
109 | (xhtml:td "abc")) | |
110 | (xhtml:tr | |
111 | (xhtml:td "Letters") | |
112 | (xhtml:td "xyz")) | |
113 | (xhtml:tr | |
114 | (xhtml:td "Single")) | |
115 | (xhtml:tr | |
116 | (xhtml:td "not a value") | |
117 | (xhtml:td "not a label") | |
118 | (xhtml:td "also not a label")))) | |
119 | ||
120 | (test-begin "cran") | |
121 | ||
122 | (test-equal "table-datum: return list of first table cell matching label" | |
123 | '((xhtml:td "abc")) | |
124 | ((@@ (guix import cran) table-datum) simple-table "Letters")) | |
125 | ||
126 | (test-equal "table-datum: return empty list if no match" | |
127 | '() | |
128 | ((@@ (guix import cran) table-datum) simple-table "Astronauts")) | |
129 | ||
130 | (test-equal "table-datum: only consider the first cell as a label cell" | |
131 | '() | |
132 | ((@@ (guix import cran) table-datum) simple-table "not a label")) | |
133 | ||
134 | ||
135 | (test-assert "cran-sxml->sexp" | |
136 | ;; Replace network resources with sample data. | |
137 | (mock ((guix build download) url-fetch | |
138 | (lambda* (url file-name #:key (mirrors '())) | |
139 | (with-output-to-file file-name | |
140 | (lambda () | |
141 | (display | |
142 | (match url | |
143 | ("mirror://cran/src/contrib/my-example-sxml_1.2.3.tar.gz" | |
144 | "source") | |
145 | (_ (error "Unexpected URL: " url)))))))) | |
146 | (match ((@@ (guix import cran) cran-sxml->sexp) sxml) | |
147 | (('package | |
148 | ('name "r-my-example-sxml") | |
149 | ('version "1.2.3") | |
150 | ('source ('origin | |
151 | ('method 'url-fetch) | |
a77adfe0 | 152 | ('uri ('cran-uri "my-example-sxml" 'version)) |
e1248602 RW |
153 | ('sha256 |
154 | ('base32 | |
155 | (? string? hash))))) | |
156 | ('build-system 'r-build-system) | |
157 | ('inputs | |
158 | ('quasiquote | |
159 | (("cairo" ('unquote 'cairo))))) | |
160 | ('propagated-inputs | |
161 | ('quasiquote | |
162 | (("r-proto" ('unquote 'r-proto)) | |
163 | ("r-rcpp" ('unquote 'r-rcpp)) | |
164 | ("r-scales" ('unquote 'r-scales))))) | |
165 | ('home-page "http://gnu.org/s/my-example-sxml") | |
166 | ('synopsis "Short description") | |
167 | ('description "Long description") | |
168 | ('license 'x11))) | |
169 | (x | |
170 | (begin | |
171 | (format #t "~s\n" x) | |
172 | (pk 'fail x #f)))))) | |
173 | ||
174 | (test-end "cran") | |
175 | ||
176 | \f | |
177 | (exit (= (test-runner-fail-count (test-runner-current)) 0)) |