;; webid-oidc, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify ;; it under the terms of the GNU Affero General Public License as ;; published by the Free Software Foundation, either version 3 of the ;; License, or (at your option) any later version. ;; This program 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 Affero General Public License for more details. ;; You should have received a copy of the GNU Affero General Public License ;; along with this program. If not, see . (define-module (webid-oidc testing) #:use-module (webid-oidc stubs) #:use-module (webid-oidc errors)) ;; This module is used only when running tests. (define-public (with-test-environment test-name f) (let ((cache-dir (format #f "tests/~a.cache" test-name)) (data-dir (format #f "tests/~a.home" test-name))) (setenv "XDG_CACHE_HOME" cache-dir) (setenv "XDG_DATA_HOME" data-dir) (catch #t (lambda () (mkdir cache-dir)) (lambda err #t)) (let ((pkg-cache-dir (format #f "~a/disfluid" cache-dir))) (catch #t (lambda () (mkdir pkg-cache-dir)) (lambda err #t)) (let ((seed-file-name (format #f "~a/seed" pkg-cache-dir))) (with-output-to-file seed-file-name (lambda () (format #t "This is the initial seed for the random number generator")))))) (with-exception-handler (lambda (error) (format (current-error-port) "The test failed, because ~a.\n" (error->str error)) (raise-exception error)) (lambda () (random-init!) (f))))