;;; nyacc/lang/util.test		-*- scheme -*-
;;; 
;;; Copyright (C) 2015,2016 Matthew R. Wette
;;; 
;;; Copying and distribution of this file, with or without modification,
;;; are permitted in any medium without royalty provided the copyright
;;; notice and this notice are preserved.  This file is offered as-is,
;;; without any warranty.

;; Test the runtime parsing utilities.
;; examples/nyacc$ guile lang/t-util.scm

(define-module (util)
  #:use-module (nyacc lang util)
  #:use-module (test-suite lib))
(cond-expand
  (guile-2 #t)
  (else
   (use-modules (nyacc compat18))))

(with-test-prefix "nyacc/util"

  ;; The input-stack used to pull in input from include files.
  (pass-if "input-stack/1"
    (equal?
     "hello world!"
     (with-output-to-string
       (lambda ()
	 (with-input-from-string "hello X!"
	   (lambda ()
	     (let iter ((ch (read-char)))
	       (unless (eq? ch #\X) (write-char ch) (iter (read-char))))
	     (push-input (open-input-string "world"))
	     (let iter ((ch (read-char)))
	       (unless (eof-object? ch) (write-char ch) (iter (read-char))))
	     (pop-input)
	     (let iter ((ch (read-char)))
	       (unless (eof-object? ch) (write-char ch) (iter (read-char))))
	     ))))))

  ;; Should return #t if something there and #f if done.
  (pass-if "input-stack/2"
    (let ((sp (open-input-string "abc")))
      (reset-input-stack) ;; maybe with-dynamic-extent
      (push-input sp)
      (and (pop-input) (not (pop-input)))))

  #!
  (pass-if "test1"
    (let* ((tl0 (make-tl 'abc 1))
	   (tl1 (tl-append tl0 2))
	   (tl2 (tl-insert tl1 'a))
	   (tl3 (tl+attr tl2 'x "true"))
	   (tl4 (tl-append tl3 20 25))
	   (tl5 (tl-insert tl4 'z))
	   (tlx tl5))
      (equal? (tl->list tlx) '(abc (@ (x "true")) z a 1 2 20 25))))
  !#

  #!
  (pass-if "test2"
    (let* ((tl (make-tl 'abc 1)))
      (set! tl (tl-append tl 2))
      (set! tl (tl-insert tl 'a))
      (set! tl (tl+attr tl 'x "true"))
      (set! tl (tl-append tl 20))
      (set! tl (tl+attr tl 'y "true"))
      (set! tl (tl-append tl 30))
      (set! tl (tl+attr tl 'z "true"))
      (set! tl (tl-append tl 40))
      (set! tl (tl-extend tl '(a b c)))
      (set! tl (tl-insert tl 'YYY))
      (set! tl (tl-append tl 'ZZZ))
      (equal? (tl->list tl)
	      '(abc (@ (x "true") (y "true") (z "true"))
		    YYY a 1 2 20 30 40 a b c ZZZ))))
  !#

  )

;;; --- last line ---
