;;; -*- mode: common-lisp; package: EDITOR-HINTS; -*-
;;; Copyright (c) 2007, Tobias C. Rittweiler, Robert P. Goldman and
;;; SIFT, LLC
;;; All rights reserved.
;;;
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions are met:
;;;     * Redistributions of source code must retain the above copyright
;;;       notice, this list of conditions and the following disclaimer.
;;;     * Redistributions in binary form must reproduce the above copyright
;;;       notice, this list of conditions and the following disclaimer in the
;;;       documentation and/or other materials provided with the distribution.
;;;     * Neither the names of Tobias C. Rittweiler, Robert P. Goldman, SIFT, LLC nor the
;;;       names of its contributors may be used to endorse or promote products
;;;       derived from this software without specific prior written permission.
;;;
;;; THIS SOFTWARE IS PROVIDED BY Tobias C. Rittweiler, Robert
;;; P. Goldman and SIFT, LLC ``AS IS'' AND ANY EXPRESS OR IMPLIED
;;; WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
;;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;;; DISCLAIMED. IN NO EVENT SHALL Tobias C. Rittweiler, Robert
;;; P. Goldman or SIFT, LLC BE LIABLE FOR ANY DIRECT, INDIRECT,
;;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;;; (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
;;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
;;; CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
;;; OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
;;; EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(in-package :editor-hints)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (asdf:oos 'asdf:load-op :rrt))

(rrt:deftest check-no-readtable-error
    (let ((rt-name (gentemp (symbol-name '#:readtable))))
      (catch 'no-table-error
	(handler-case
	    (eval `(in-readtable ',rt-name))
	  (error (condition)
	    (let ((string (format nil "~A" condition))
		  (template (format nil "No such readtable: ~A" rt-name)))
	      (if
		  (equal (subseq string 0 (length template)) template)
		  (throw 'no-table-error t)
		(format t "Unexpected error value -- error was: ~A" condition)))))
	nil)))

(rrt:deftest check-find-readtable
    (let* ((rt-name (gentemp (symbol-name '#:readtable) :keyword))
	   (readtable (eval `(defreadtable ,rt-name
				 (:use nil)))))
      (eq readtable (find-readtable rt-name))))

					       
(rrt:deftest check-unregister-readtable
    (let* ((rt-name (gentemp (symbol-name '#:readtable) :keyword))
	   (readtable (eval `(defreadtable ,rt-name
				 (:use nil)))))
      (and 
       (eq readtable (find-readtable rt-name))
       (progn
	 (unregister-readtable rt-name)
	 (null (find-readtable rt-name))))))

(defstruct var name)
(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun make-a-var (stream char)
    (declare (ignore char))
    `(make-var :name ',(read stream t nil t))))

(rrt:deftest check-a-readtable
    (let* ((rt-name (gentemp (symbol-name '#:readtable) :keyword))
	   (readtable (eval `(defreadtable ,rt-name
				 (:use nil)
			       (:macro-char #\? #'make-a-var nil)))))
      (and 
       (eq readtable (find-readtable rt-name))
       (let ((var-struct
	      (let ((*readtable* (find-readtable rt-name))
		    (*package* #.(find-package *package*)))
		(eval (read-from-string "?foo")))))
	 (equalp (make-var :name 'foo) var-struct))
       (progn
	 (unregister-readtable rt-name)
	 (null (find-readtable rt-name))))))

;;; make sure that the library won't let you redefine the standard
;;; readtable.
(rrt:deftest check-bad-readtable-redef
    (catch 'bad-readtable
      (handler-case (eval `(defreadtable :standard
				 (:use nil)))
	(error (condition)
	       (throw 'bad-readtable t)))
      nil))