Source

HH-Parse / tests.lisp

Full commit
(defpackage :hh-parse-tests
  (:use :cl :asdf :lisp-unit :hh-utils :hh-parse))

(in-package :hh-parse-tests)

;; start fresh--remove any tests that no longer exist
(remove-all-tests)


;; ---------------------------------------------------------------------------------------------------------------------
;; Sample grammars

(defgrammar grammar-419 S
  (S (^ (:i E :t S SP) :a))
  (SP (:e (? S)))
  (E (:b)))

(defgrammar grammar-420 s
  (s (l eq r)
     (r))
  (l (star r)
     (id))
  (r (l)))

(defgrammar numbers-grammar number  
  ;; literals are digits, decimal, plus, minus
  (integer (digit)
	   (integer digit))
  (numeric-value ( (? (^ plus minus)) integer (? decimal integer)))
  (number (numeric-value)))

(defgrammar html-grammar document
  ( tag-name  (identifier) )
  
  ( attribute-name  (identifier) )

  (integer (digit)
	   (integer digit))
  (numeric-value ( (? (^ plus minus)) integer (? decimal integer)))
  (number (numeric-value))

  (es (? ws))

  ( quantity-value  (^ number
		       ( number pct-symbol)
		       ( number pct)
		       ( number px) ) )

  ( attribute-value  (^ quantity-value
			string-value))

  ( attribute  (attribute-name es equal-sign es attribute-value))

  ( attribute-list  ( attribute (* ws attribute)))

  ( start-tag  (lt es tag-name (? ws attribute-list) es gt))

  ( end-tag  (lt es forward-slash es tag-name  gt))

  ( single-tag  (lt es tag-name (? ws attribute-list) es forward-slash es gt))

  ( tag  (^ single-tag
	    (start-tag es (* (^ tag html-text)) es end-tag)))
  (document (tag)))

(deflexer html-lexer (:text)
  (:tag #'digit-char-p digit)
  (:tag #'alpha-char-p identifier :accumulate #'(lambda (nc)
						  (and nc
						       (or (digit-char-p nc) 
							   (alpha-char-p nc)
							   (equal #\_ nc)))))
  (:text #\< lt :state :tag)
  (:tag #\> gt :state :text)
  (:tag #\+ plus)
  (:tag #\- minus)
  (:tag #\. decimal)
  (:tag #\/ forward-slash)
  (:tag #\% percent-symbol)
  (:tag #\= equal-sign)
  (:tag #'whitespace-p ws :accumulate #'whitespace-p)
  (:text t html-text :accumulate #'(lambda (nc) (char/= #\< nc))))

;; =====================================================================================================================
;;
;; Parsing tests
;;
;; =====================================================================================================================

(define-test source-text-tests 
  (let ((text "<foo bar=1>borp whaple</foo>"))

    (let ((lexer (make-instance 'html-lexer)))
      (setf (source-text lexer) text)

      (assert-equal (source-text (hh-parse::source lexer)) text))

    (let* ((grammar (html-grammar))
	   (lexer (make-instance 'html-lexer))
	   (parser (make-parser lexer grammar)))
      (setf (source-text parser) text)

      (assert-equal (source-text (hh-parse::source (hh-parse::lexer parser))) text))

    ))

(define-test html-parsing-tests
    (let* ((grammar (html-grammar))
	   (source (make-source "<foo bar=1>borp whaple</foo>"))
	   (lexer (make-instance 'html-lexer :source source))
	   (parser (make-parser lexer grammar)))
      (multiple-value-bind (result value) (parse-input parser)
	(assert-equal :succeeded result)
	(assert-equal 'document value)))

    (let* ((grammar (html-grammar))
	   (source (make-source "<foobar=1>borp whaple</foo>"))
	   (lexer (make-instance 'html-lexer :source source))
	   (parser (make-parser lexer grammar)))
      (multiple-value-bind (result value) (parse-input parser)
	(assert-equal :failed result)
	(assert-equal `(identifier "foobar") value)))

    (let* ((grammar (html-grammar))
	   (source (make-source "<foo bar=1>borp whaple</foo"))
	   (lexer (make-instance 'html-lexer :source source))
	   (parser (make-parser lexer grammar)))
      (multiple-value-bind (result value) (parse-input parser)
	(assert-equal :failed result)
	(assert-equal `(identifier "foo") value)))

    (let* ((grammar (html-grammar))
	   (source (make-source "<foo b ar=1>borp whaple</foo>"))
	   (lexer (make-instance 'html-lexer :source source))
	   (parser (make-parser lexer grammar)))
      (multiple-value-bind (result value) (parse-input parser)
	(assert-equal :failed result)
	(assert-equal `(ws " ") value)))

    (let* ((grammar (html-grammar))
	   (source (make-source "<foo>"))
	   (lexer (make-instance 'html-lexer :source source))
	   (parser (make-parser lexer grammar)))
      (multiple-value-bind (result value) (parse-input parser)
	(assert-equal :failed result)
	(assert-equal `(gt #\>) value)))

    )

;; =====================================================================================================================
;;
;; Source tests
;;
;; =====================================================================================================================
(define-test source-code-file-tests
  (let ((text "hello world!
")
	(src (make-instance 'source-code-file)))
    (setf (source-text src) text)
    (assert-equal text (source-text src) )
    (assert-true (hh-parse::positions-equal (current-position src)
					    (make-instance 'source-code-position :line 1 :column 0)))
    (assert-equal 2 (length (lines-of src)))))

(run-tests)