;;; Excercise the `resolve' routines. -*- Scheme -*-
;;;
;;; Copyright (C) 2009, 2021 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 resolve)
#:use-module (skribilo ast)
#:use-module (skribilo engine)
#:use-module (skribilo resolve)
#:use-module (skribilo package base)
#:use-module (srfi srfi-64))
(define %engine
(find-engine 'base))
(test-begin "resolve")
(test-assert "parents"
(let* ((doc (document #:title "Doc"
(chapter #:title "C"
(section #:title "S"
(p "par")))))
(ch (car (markup-body doc)))
(sec (car (markup-body ch)))
(par (car (markup-body sec))))
(and (is-markup? ch 'chapter)
(eq? (ast-parent ch) 'unspecified)
(begin
(resolve! doc %engine '())
(and (eq? (ast-parent ch) doc)
(eq? (ast-parent sec) ch)
(eq? (ast-parent par) sec))))))
(test-assert "root document has no parent"
(let ((doc (document #:title "Doc")))
(resolve! doc %engine '())
(and (not (ast-parent doc))
(eq? doc (ast-document doc)))))
(test-assert "nested document has a parent"
;; Nested documents are sometimes used in the manual.
(let* ((doc (document #:title "Doc"
(document #:title "Nested Doc"
(chapter #:title "C"))))
(sub (car (markup-body doc)))
(ch (car (markup-body sub))))
(resolve! doc %engine '())
(and (not (ast-parent doc))
(document? sub)
(eq? doc (ast-document doc))
(eq? doc (ast-parent sub)))))
(test-assert "nested document is its own `ast-document'"
(let* ((doc (document #:title "Doc"
(document #:title "Nested Doc"
(chapter #:title "C"))))
(sub (car (markup-body doc)))
(ch (car (markup-body sub))))
(resolve! doc %engine '())
(and (document? sub)
(eq? sub (ast-document sub))
(eq? sub (ast-document ch)))))
(test-assert "unresolved node in body"
(let* ((resolved? #f)
(doc (document #:title "Doc"
(resolve (lambda (n e env)
(set! resolved? #t))))))
(and (not resolved?)
(begin
(resolve! doc %engine '())
resolved?))))
(test-assert "unresolved node in unresolved node in body"
(let* ((resolved? #f)
(doc (document #:title "Doc"
(resolve (lambda (n e env)
(resolve (lambda (n e env)
(set! resolved? #t))))))))
(and (not resolved?)
(begin
(resolve! doc %engine '())
resolved?))))
(test-assert "unresolved node in options"
(let* ((resolved? #f)
(doc (document #:title
(resolve (lambda (n e env)
(set! resolved? #t)))
"body...")))
(and (not resolved?)
(begin
(resolve! doc %engine '())
resolved?))))
(test-assert "unresolved node in processor body"
(let* ((resolved? #f)
(doc (document #:title "Doc"
(processor #:combinator (lambda (e1 e2) e1)
(resolve (lambda (n e env)
(set! resolved? #t)))))))
(and (not resolved?)
(begin
(resolve! doc %engine '())
resolved?))))
(test-assert "unresolved node in nested document"
(let* ((resolved? #f)
(doc (document #:title "Outer"
(document #:title "Inner"
(resolve (lambda (n e env)
(set! resolved? #t)))))))
(and (not resolved?)
(begin
(resolve! doc %engine '())
resolved?))))
(test-assert "unresolved node product has a parent"
(let* ((doc (document #:title "Doc"
(resolve (lambda (n e env)
(chapter #:title "C"))))))
(resolve! doc %engine '())
(let ((ch (car (markup-body doc))))
(and (is-markup? ch 'chapter)
(eq? (ast-parent ch) doc)))))
(test-assert "node bindings"
(let* ((doc (document #:title "Doc"
(chapter #:title "C" #:ident "c"
(section #:title "S" #:ident "s"))))
(ch (car (markup-body doc)))
(sec (car (markup-body ch))))
(and (not (document-lookup-node doc "c"))
(not (document-lookup-node doc "s"))
(begin
(resolve! doc %engine '())
(and (eq? (document-lookup-node doc "c") ch)
(eq? (document-lookup-node doc "s") sec))))))
(test-assert "unresolved node bindings"
;; Make sure nodes returned by `unresolved' nodes are eventually bound.
(let* ((doc (document #:title "Doc"
(resolve (lambda (n e env)
(chapter #:title "C" #:ident "c"
(section #:title "S" #:ident "s")))))))
(and (not (document-lookup-node doc "c"))
(not (document-lookup-node doc "s"))
(begin
(resolve! doc %engine '())
(and (is-markup? (document-lookup-node doc "c") 'chapter)
(is-markup? (document-lookup-node doc "s") 'section))))))
(test-assert "nested document bindings"
;; Bindings in nested documents are scoped. This was not the case prior
;; to 0.9.2.
(let* ((doc (document #:title "Doc"
(chapter #:ident "outer")
(document #:title "Nested Doc"
(chapter #:ident "inner"))))
(out (car (markup-body doc)))
(sub (cadr (markup-body doc)))
(in (car (markup-body sub))))
(resolve! doc %engine '())
(and (let ((x (document-lookup-node doc "outer")))
(and (is-markup? x 'chapter)
(eq? (ast-document x) doc)))
(not (document-lookup-node doc "inner"))
(let ((x (document-lookup-node sub "inner")))
(and (is-markup? x 'chapter)
(eq? (ast-document x) sub))))))
(test-assert "resolved nested document bindings"
;; Prior to 0.9.2, nodes of a sub-document returned by an `unresolved' node
;; would be bound in the root document.
(let* ((doc (document #:title "Doc"
(resolve (lambda (n e env)
(document #:title "Nested Doc"
(chapter #:ident "inner")))))))
(resolve! doc %engine '())
(and (not (document-lookup-node doc "inner"))
(let* ((sub (car (markup-body doc)))
(ch (car (markup-body sub)))
(x (document-lookup-node sub "inner")))
(and (document? sub)
(is-markup? x 'chapter)
(eq? x ch)
(eq? (ast-parent x) sub)
(eq? (ast-document x) sub))))))
(test-assert "node bindings in processor body"
(let* ((doc (document #:title "Doc"
(processor #:combinator (lambda (e1 e2) e1)
(chapter #:ident "c")))))
(resolve! doc %engine '())
(let* ((proc (car (markup-body doc)))
(ch (car (markup-body proc)))
(ch* (document-lookup-node doc "c")))
(eq? ch ch*))))
(test-end "resolve")
