Add ability to download tests for offline use

Julien LepillerWed Oct 07 01:25:57+0200 2020

044afc6

Add ability to download tests for offline use

.gitignore

1212
config.status
1313
pre-inst-env
1414
tests/*.scm
15+
test-files

Makefile.am

2626
2727
TEST_EXTENSIONS = .scm
2828
SCM_LOG_DRIVER = \
29+
  LANG=en_US.UTF-8 \
2930
  $(top_builddir)/pre-inst-env $(GUILE) --no-auto-compile -e main \
3031
  $(top_srcdir)/test-driver.scm
3132
TESTS = tests/turtle.scm tests/semantics.scm tests/nquads.scm
3233
EXTRA_DIST += $(TEST_MODULES) test-driver.scm
34+
35+
update-test-files:
36+
	$(top_builddir)/pre-inst-env $(GUILE) --no-auto-compile \
37+
	$(top_srcdir)/test-modules/download-tests.scm

README.md

4242
sudo make install
4343
```
4444
45-
You will need guile and guile-json for it to work.  Again, the best way to obtain
46-
the dependencies is to use Guix from this repository:
45+
You will need guile for it to work.  Again, the best way to obtain the
46+
dependencies is to use Guix from this repository:
4747
4848
```bash
4949
guix environment -l guix.scm

6161
-------
6262
6363
The tests include running the official
64-
[test suite](https://w3c.github.io/json-ld-api/tests/).  It requires network
65-
access.  To run it, use:
64+
[test suite](https://www.w3.org/TR/2014/NOTE-rdf11-testcases-20140225/).  It
65+
requires network access.  To run it, use:
6666
6767
```bash
6868
make check
6969
```
7070
71-
Please [report](https://framagit.org/tyreunom/guile-jsonld/issues) any failure!
71+
We also provide a way to download the necessary files for tests, so you can
72+
run tests offline afterwards.  To download the files, run:
73+
74+
```bash
75+
make update-test-files
76+
```
77+
78+
Please [report](https://framagit.org/tyreunom/guile-rdf/issues) any failure!
7279
7380
Documentation
7481
-------------

test-modules/download-tests.scm unknown status 1

1+
;;;; Copyright (C) 2020 Julien Lepiller <julien@lepiller.eu>
2+
;;;;
3+
;;;; This library is free software; you can redistribute it and/or
4+
;;;; modify it under the terms of the GNU Lesser General Public
5+
;;;; License as published by the Free Software Foundation; either
6+
;;;; version 3 of the License, or (at your option) any later version.
7+
;;;;
8+
;;;; This library is distributed in the hope that it will be useful,
9+
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
10+
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
11+
;;;; Lesser General Public License for more details.
12+
;;;;
13+
;;;; You should have received a copy of the GNU Lesser General Public
14+
;;;; License along with this library; if not, write to the Free Software
15+
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
16+
;;;;
17+
18+
(define-module (test-modules download-tests)
19+
  #:use-module (ice-9 match)
20+
  #:use-module (rnrs bytevectors)
21+
  #:use-module (test-modules test-case)
22+
  #:use-module (test-modules testsuite)
23+
  #:use-module (turtle tordf)
24+
  #:use-module (web client)
25+
  #:use-module (web response)
26+
  #:export (download-test-files))
27+
28+
(define test-dir "test-files")
29+
30+
(define base-url "http://www.w3.org/2013/")
31+
32+
(define (get-test-doc url)
33+
  "Get a test suite object from the manifest at @var{url}."
34+
  (call-with-values
35+
    (lambda ()
36+
      (http-get url))
37+
    (lambda (hdr body)
38+
      (if (equal? (response-code hdr) 200)
39+
          (if (string? body)
40+
              body
41+
              (utf8->string body))
42+
          (throw 'error-fetching-test-manifest (response-code hdr))))))
43+
44+
(define (mkdir-p dir)
45+
  (unless (file-exists? dir)
46+
    (mkdir-p (dirname dir))
47+
    (mkdir dir)))
48+
49+
(define (download url)
50+
  (let ((filename (string-append test-dir "/"
51+
                                 (substring url (string-length base-url)))))
52+
    (mkdir-p (dirname filename))
53+
    (call-with-output-file filename
54+
      (lambda (port)
55+
        (display (get-test-doc url) port)))))
56+
57+
(define (download-test-files)
58+
  (for-each
59+
    (lambda (manifest)
60+
      (pk 'downloading manifest)
61+
      (download manifest)
62+
      (let ((plan (rdf->test-plan
63+
                    (turtle->rdf (get-test-doc manifest) manifest)
64+
                    manifest)))
65+
        (for-each
66+
          (lambda (test)
67+
            (download (test-case-action test))
68+
            (when (test-case-result test)
69+
              (download (test-case-result test))))
70+
          plan)))
71+
    manifests))
72+
73+
(download-test-files)