From 1c445dd093cb6a02289f25324039ce1cba358145 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès
Date: Thu, 17 May 2012 23:37:43 +0200
Subject: 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.
---
 tests/Makefile.am   |   3 +-
 tests/location.test | 101 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 103 insertions(+), 1 deletion(-)
 create mode 100644 tests/location.test

(limited to 'tests')

diff --git a/tests/Makefile.am b/tests/Makefile.am
index 84cb0c9..1a1444a 100644
--- a/tests/Makefile.am
+++ b/tests/Makefile.am
@@ -7,7 +7,8 @@ TESTS =						\
   ast.test					\
   resolve.test					\
   readers/rss-2.test				\
-  engines/info.test
+  engines/info.test				\
+  location.test
 
 EXTRA_DIST = $(TESTS)
 
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:
-- 
cgit v1.2.3