aboutsummaryrefslogtreecommitdiff
path: root/tests/location.test
diff options
context:
space:
mode:
authorLudovic Courtès2012-05-17 23:37:43 +0200
committerLudovic Courtès2012-05-17 23:37:43 +0200
commit1c445dd093cb6a02289f25324039ce1cba358145 (patch)
treee420e91ef8345c6918af7133911a58c9746dcfc8 /tests/location.test
parentf59dc186a84504715faf141d1d7bcc9e3ca9d2e7 (diff)
downloadskribilo-1c445dd093cb6a02289f25324039ce1cba358145.tar.gz
skribilo-1c445dd093cb6a02289f25324039ce1cba358145.tar.lz
skribilo-1c445dd093cb6a02289f25324039ce1cba358145.zip
Change `define-markup' to generate a macro, to capture location syntactically.
* src/guile/skribilo/lib.scm (dsssl->guile-formals): New procedure, formerly `fix-rest-arg' procedure in `define-markup'. (define-markup)[guile-2]: Turn into a macro-generating macro, such that markups capture their invocation location syntactically. * src/guile/skribilo/location.scm (source-properties->location): New procedure. (invocation-location): Use it. * src/guile/skribilo/package/base.scm (handle): Move above first use, since it's now a macro on Guile 2.0. * src/guile/skribilo/package/slide.scm (slide-vspace): Likewise. * src/guile/skribilo/package/eq.scm: Use (skribilo package base) instead of autoloading it. * tests/Makefile.am (TESTS): Add `location.test'. * tests/location.test: New file.
Diffstat (limited to 'tests/location.test')
-rw-r--r--tests/location.test101
1 files changed, 101 insertions, 0 deletions
diff --git a/tests/location.test b/tests/location.test
new file mode 100644
index 0000000..c973f63
--- /dev/null
+++ b/tests/location.test
@@ -0,0 +1,101 @@
+;;; Check the AST source location info. -*- Scheme -*-
+;;;
+;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of Skribilo.
+;;;
+;;; Skribilo is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU Lesser General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Skribilo 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 Lesser
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public License
+;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (tests location)
+ :use-module (skribilo ast)
+ :use-module (skribilo reader)
+ :use-module (skribilo evaluator)
+ :use-module (skribilo package base)
+ :use-module (skribilo location)
+ :use-module (srfi srfi-1)
+ :use-module (srfi srfi-64)
+ :use-module (ice-9 match))
+
+(cond-expand (guile-2 (begin))
+ (else (use-modules (ice-9 syncase))))
+
+(define-syntax call-with-code
+ (syntax-rules ()
+ ((_ strings ... thunk)
+ (let ((s (string-join '(strings ...) "\n")))
+ (call-with-input-string s
+ (lambda (p)
+ (set-port-filename! p "the-file.skb")
+ (set-port-line! p 0)
+ (set-port-column! p 0)
+ (thunk p)))))))
+
+(define (location->list loc)
+ (and (location? loc)
+ (list (location-file loc)
+ (location-line loc)
+ (location-column loc))))
+
+(define (locations ast)
+ ;; Return a location tree for AST and its children.
+ (let loop ((ast ast))
+ (cond ((node? ast)
+ (and=> (location->list (ast-loc ast))
+ (lambda (loc)
+ (append loc (map loop (node-children ast))))))
+ ((ast? ast)
+ (location->list (ast-loc ast)))
+ (else
+ '()))))
+
+(define-syntax test-location
+ (syntax-rules ()
+ ((_ name expected doc)
+ (test-equal name
+ 'expected
+ (call-with-code doc
+ (lambda (p)
+ (pk (locations (evaluate-ast-from-port p)))))))))
+
+(*document-reader* (make-reader 'skribe))
+
+
+(test-begin "location")
+
+(test-location "document"
+ ("the-file.skb" 1 1)
+ "(document)")
+
+(test-location "document + sections"
+ ("the-file.skb" 2 5
+ ("the-file.skb" 3 7)
+ ("the-file.skb" 4 7
+ ("the-file.skb" 5 9
+ ("the-file.skb" 6 11))))
+ " ; 1
+ (document ; 2
+ (chapter :title \"foo\") ; 3
+ (chapter :title \"bar\" ; 4
+ (section :title \"baz\" ; 5
+ (p [Paragraph.]))))") ; 6
+
+(test-end "location")
+
+
+(exit (= (test-runner-fail-count (test-runner-current)) 0))
+
+;; Local Variables:
+;; eval: (put 'call-with-code 'scheme-indent-function 1)
+;; eval: (put 'test-location 'scheme-indent-function 1)
+;; End: