;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2018, 2019, 2020 Ludovic Courtès ;;; ;;; 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 . (define-module (test-records) #:use-module (srfi srfi-1) #:use-module (srfi srfi-64) #:use-module (ice-9 match) #:use-module (ice-9 regex) #:use-module (guix records)) (define (test-module) ;; A module in which to evaluate thin
aboutsummaryrefslogtreecommitdiff
blob: 6cdc4b3330bdaee28a20c8e5461f0503a11992e2 (about) (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Roel Janssen <roel@gnu.org>
;;;
;;; 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 (gnu packages inklingreader)
  #:use-module ((guix licenses) #:prefix license:)
  #:use-module (guix packages)
  #:use-module (guix download)
  #:use-module (guix build-system gnu)
  #:use-module (gnu packages)
  #:use-module (gnu packages autotools)
  #:use-module (gnu packages glib)
  #:use-module (gnu packages gnome)
  #:use-module (gnu packages gtk)
  #:use-module (gnu packages libusb)
  #:use-module (gnu packages pkg-config))

(define-public inklingreader
  (package
    (name "inklingreader")
    (version "0.8")
    (source (origin
              (method url-fetch)
              (uri (string-append
                    "ftp://alpha.gnu.org/gnu/inklingreader/inklingreader-"
                    version ".tar.gz"))
              (sha256
               (base32
                "0ikg95mgwfqh0bq4dzvkfmdiycacqvv27g91hl6adwk5y3gzl96g"))))
    (build-system gnu-build-system)
    (inputs
     `(("glib" ,glib)
       ("cairo" ,cairo)
       ("gtk+" ,gtk+)
       ("librsvg" ,librsvg)
       ("libusb" ,libusb)))
    (native-inputs
     `(("pkg-config" ,pkg-config)))
    (home-page "https://www.gnu.org/software/inklingreader/")
    (synopsis "Wacom Inkling sketch format conversion and manipulation")
    (description
     "GNU InklingReader is a package to support the Wacom Inkling device,
including data conversion to various free formats, basic editing features,
and an Inkscape plugin.")
    (license license:gpl3+)))
first) (eq? first y))))))) (test-assert "define-record-type* & delayed" (begin (define-record-type* foo make-foo foo? (bar foo-bar (delayed))) (let* ((calls 0) (x (foo (bar (begin (set! calls (1+ calls)) 3))))) (and (zero? calls) (equal? (foo-bar x) 3) (= 1 calls) (equal? (foo-bar x) 3) (= 1 calls) (equal? (foo-bar x) 3) (= 1 calls))))) (test-assert "define-record-type* & delayed & default" (let ((mark #f)) (define-record-type* foo make-foo foo? (bar foo-bar (delayed) (default mark))) (let ((x (foo))) (set! mark 42) (and (equal? (foo-bar x) 42) (begin (set! mark 7) (equal? (foo-bar x) 42)))))) (test-assert "define-record-type* & delayed & inherited" (begin (define-record-type* foo make-foo foo? (bar foo-bar (delayed)) (baz foo-baz (delayed))) (let* ((m 1) (n #f) (x (foo (bar m) (baz n))) (y (foo (inherit x) (baz 'b)))) (set! n 'a) (and (equal? (foo-bar x) 1) (eq? (foo-baz x) 'a) (begin (set! m 777) (equal? (foo-bar y) 1)) ;promise was already forced (eq? (foo-baz y) 'b))))) (test-assert "define-record-type* & wrong field specifier" (let ((exp '(begin (define-record-type* foo make-foo foo? (bar foo-bar (default 42)) (baz foo-baz)) (foo (baz 1 2 3 4 5)))) ;syntax error (loc (current-source-location))) ;keep this alignment! (catch 'syntax-error (lambda () (eval exp (test-module)) #f) (lambda (key proc message location form subform . _) (and (eq? proc 'foo) (string-match "invalid field" message) (equal? subform '(baz 1 2 3 4 5)) (equal? form '(foo (baz 1 2 3 4 5))) ;; Make sure the location is that of the field specifier. ;; See . (lset= equal? (pk 'expected-loc `((line . ,(- (assq-ref loc 'line) 1)) ,@(alist-delete 'line loc))) (pk 'actual-loc location))))))) (test-assert "define-record-type* & wrong field specifier, identifier" (let ((exp '(begin (define-record-type* foo make-foo foo? (bar foo-bar (default 42)) (baz foo-baz)) (foo baz))) ;syntax error (loc (current-source-location))) ;keep this alignment! (catch 'syntax-error (lambda () (eval exp (test-module)) #f) (lambda (key proc message location form subform . _) (and (eq? proc 'foo) (string-match "invalid field" message) (equal? subform 'baz) (equal? form '(foo baz)) ;; Here the location is that of the parent form. (lset= equal? (pk 'expected-loc `((line . ,(- (assq-ref loc 'line) 2)) ,@(alist-delete 'line loc))) (pk 'actual-loc location))))))) (test-assert "define-record-type* & missing initializers" (catch 'syntax-error (lambda () (eval '(begin (define-record-type* foo make-foo foo? (bar foo-bar (default 42)) (baz foo-baz)) (foo)) (test-module)) #f) (lambda (key proc message location form . args) (and (eq? proc 'foo) (string-match "missing .*initialize.*baz" message) (equal? form '(foo)))))) (test-assert "define-record-type* & extra initializers" (catch 'syntax-error (lambda () (eval '(begin (define-record-type* foo make-foo foo? (bar foo-bar (default 42))) (foo (baz 'what?))) (test-module)) #f) (lambda (key proc message location form . args) (and (string-match "extra.*initializer.*baz" message) (eq? proc 'foo))))) (test-assert "define-record-type* & inherit & extra initializers" (catch 'syntax-error (lambda () (eval '(begin (define-record-type* foo make-foo foo? (bar foo-bar (default 42))) (foo (inherit (foo)) (baz 'what?))) (test-module)) #f) (lambda (key proc message location form . args) (and (string-match "extra.*initializer.*baz" message) (eq? proc 'foo))))) (test-assert "define-record-type* & duplicate initializers" (let ((exp '(begin (define-record-type* foo make-foo foo? (bar foo-bar (default 42))) (foo (bar 1) (bar 2)))) (loc (current-source-location))) ;keep this alignment! (catch 'syntax-error (lambda () (eval exp (test-module)) #f) (lambda (key proc message location form . args) (and (string-match "duplicate.*initializer" message) (eq? proc 'foo) ;; Make sure the location is that of the field specifier. (lset= equal? (pk 'expected-loc `((line . ,(- (assq-ref loc 'line) 1)) ,@(alist-delete 'line loc))) (pk 'actual-loc location))))))) (test-assert "ABI checks" (let ((module (test-module))) (eval '(begin (define-record-type* foo make-foo foo? (bar foo-bar (default 42))) (define (make-me-a-record) (foo))) module) (unless (eval '(foo? (make-me-a-record)) module) (error "what?" (eval '(make-me-a-record) module))) ;; Redefine with an additional field. (eval '(define-record-type* foo make-foo foo? (baz foo-baz) (bar foo-bar (default 42))) module) ;; Now 'make-me-a-record' is out of sync because it does an ;; 'allocate-struct' that corresponds to the previous definition of . (catch 'record-abi-mismatch-error (lambda () (eval '(foo? (make-me-a-record)) module) #f) (match-lambda* ((key 'abi-check (? string? message) (rtd) . _) (eq? rtd (eval ' module))))))) (test-equal "recutils->alist" '((("Name" . "foo") ("Version" . "0.1") ("Synopsis" . "foo bar") ("Something_else" . "chbouib")) (("Name" . "bar") ("Version" . "1.5"))) (let ((p (open-input-string " # Comment following an empty line, and # preceding a couple of empty lines, all of # which should be silently consumed. Name: foo Version: 0.1 # Comment right in the middle, # spanning two lines. Synopsis: foo bar Something_else: chbouib # Comment right before. Name: bar Version: 1.5 # Comment at the end."))) (list (recutils->alist p) (recutils->alist p)))) (test-equal "recutils->alist with + lines" '(("Name" . "foo") ("Description" . "1st line,\n2nd line,\n 3rd line with extra space,\n4th line without space.")) (recutils->alist (open-input-string " Name: foo Description: 1st line, + 2nd line, + 3rd line with extra space, +4th line without space."))) (test-equal "alist->record" '((1 2) b c) (alist->record '(("a" . 1) ("b" . b) ("c" . c) ("a" . 2)) list '("a" "b" "c") '("a"))) (test-end)