Commits

Phil Hargett  committed f7d6a58

Fleshed out HTML tests, with several negative tests. So far so good; gonna merge next

  • Participants
  • Parent commits f922613
  • Branches parsing

Comments (0)

Files changed (6)

File grammar.lisp

       new-grammar)))
 
 (defun transform-extended-grammar-to-fundamental (start-rule-name grammar ) 
-  (transform-for-nil 'start
+  (transform-for-nil 'start-rule
 		     (let ((*new-rules* nil)
-			   (augmented-grammar (cons `(start (,start-rule-name)) grammar)))
+			   (augmented-grammar (cons `(start-rule (,start-rule-name)) grammar)))
 		       (append (for-each-rhs augmented-grammar
 					     #'(lambda (rhs)		      
 						 (transform-rhs (if (listp rhs) rhs (list rhs)))))
        finally (return  states))))
 
 (defun make-grammar (specification)
-  (let* ((states (lr1-states-for-grammar specification 'start))
+  (let* ((states (lr1-states-for-grammar specification 'start-rule))
 	 (non-terminals (non-terminals-in-grammar specification))
 	 (action-table (make-instance 'lr-parse-table :states (length states)))
 	 (goto-table (make-instance 'lr-parse-table :states (length states))))
       			;; reducing or accepting -- use lookahead to decide
 			(with-slots (lookahead production) item
 			  (if (and (equal :eof lookahead)
-				   (equal 'start (slot-value production 'rule-name)))
+				   (equal 'start-rule (slot-value production 'rule-name)))
 			      ;; accepting
 			      (record-accept i lookahead production)
 			      ;; reducing

File hh-parse.asd

 	       (:file "grammar")
 	       (:file "parser")
 	       (:file "source")
-	       (:file "samples")
 	       )
   :depends-on (
 	       ; external packages
 	       "lisp-unit"
 
 	       ;; project packages
+	       "hh-utils"
                "hh-parse"
         )
   )

File package-hh-parse.lisp

 
    ;; source
    #:source-code-file
+   #:source-code-position
    #:make-source
   
    #:source-text
    #:current-column-position
 
    ;; grammars
+   ;; #:+ from CL
+   ;; #:* from CL
+   #:? 
+   #:^ 
+
+   #:start-rule
    #:defgrammar
 
    ;; lexers
    #:parse-input
    #:get-parse-result
 
-   ;; samples
-   #:html-grammar
-   #:html-lexer
-
    ))
 
 (defun make-parser (lexer grammar)
   (let ((parser (make-instance 'lalr1-parser :lexer lexer :grammar grammar)))
-    (push (list 0 'start) (stack parser))
+    (push (list 0 'start-rule) (stack parser))
     parser))
 
 (defun get-parse-result (parser)

File samples.lisp

-(in-package :hh-parse)
-
-;; ---------------------------------------------------------------------------------------------------------------------
-;; 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))))
-
 (defpackage :hh-parse-tests
-  (:use :cl :asdf :lisp-unit :hh-parse)
+  (: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 literal-test
-  (assert-true (node-equal (lit "foo")
-			   (with-input-from-string (is "foo")
-			     (parse is (lit "foo"))
-			     )
-			   )
-	       )
-  (assert-false (with-input-from-string (is "bar")
-		 (parse is (lit "foo"))
-		 )
-	       )
-  (assert-false (with-input-from-string (is "")
-		 (parse is (lit "foo"))
-		 )
-	       )
-  (assert-false (with-input-from-string (is "foo1")
-		 (parse is (lit "foo"))
-		 )
-	       )
-  (assert-false (with-input-from-string (is "1foo")
-		 (parse is (lit "foo"))
-		 )
-	       )
+(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)))
+
     )
 
-(define-test alternative-test
-  (assert-true (node-equal (lit "foo")
-			   (with-input-from-string (is "foo")
-			     (parse is (alt (lit "foo")) )
-			     )
-			   )
-	       )
-  (assert-true (node-equal (lit "foo")
-			   (with-input-from-string (is "foo")
-			     (parse is (alt (lit "foo") (lit "bar") )
-				    )
-			     )
-			   )
-	       )
-  (assert-true (node-equal (lit "bar")
-			   (with-input-from-string (is "bar")
-			     (parse is (alt (lit "foo") (lit "bar") )
-				    )
-			     )
-			   )
-	       )
-  (assert-false (with-input-from-string (is "foob")
-		  (parse is (alt (lit "foo") (lit "bar") )
-			 )
-		  )
-		)
-  (assert-false (with-input-from-string (is "bfoo")
-		  (parse is (alt (lit "foo") (lit "bar") )
-			 )
-		  )
-		)
-  (assert-false (with-input-from-string (is "barfoo")
-		  (parse is (alt (lit "foo") (lit "bar") )
-			 )
-		  )
-		)
-  )
-
-(define-test sequence-test
-  (assert-true (node-equal (lit "foo") 
-			   (with-input-from-string (is "foo")
-			     (parse is (seq (lit "foo")) )
-			     )
-			   )
-	       )
-  (assert-false (with-input-from-string (is "bar")
-		 (parse is (seq (lit "foo")) )
-		 )
-	       )
-  (assert-false (with-input-from-string (is "")
-		 (parse is (seq (lit "foo")) )
-		 )
-	       )
-  (assert-false (with-input-from-string (is "foo1")
-		 (parse is (seq (lit "foo")) )
-		 )
-	       )
-  (assert-false (with-input-from-string (is "1foo")
-		 (parse is (seq (lit "foo")) )
-		 )
-	       )
-  )
-
-(define-test repeat-test
-  (assert-true (node-equal (lit "foo")
-			   (with-input-from-string (is "foo")
-			     (parse is (rep (lit "foo")) )
-			     )
-			   )
-	       )
-  (assert-true (node-equal (lit "foobar")
-			   (with-input-from-string (is "foobar")
-			     (parse is (seq (rep (lit "foo")) (lit "bar")) )
-			     )
-			   )
-	       )
-  (assert-false (with-input-from-string (is "foob")
-		  (parse is (rep (lit "foo")) )
-		  )
-		)
-  (assert-false (with-input-from-string (is "foof")
-		 (parse is (rep (lit "foo")))
-		 )
-		)
-  (assert-false (with-input-from-string (is "foofo")
-		 (parse is (rep (lit "foo")))
-		 )
-		)
-  (assert-true (node-equal (lit "foobar")
-			   (with-input-from-string (is "foobar")
-			     (parse is (seq (rep (lit "foo")) (rep (lit "bar"))) )
-			     )
-			   )
-	       )
-  (assert-true (node-equal (lit "foofoo")
-			   (with-input-from-string (is "foofoo")
-			     (parse is (rep (lit "foo")) )
-			     )
-			   )
-	       )
-  (assert-true (node-equal (lit "foobarfoobarbaz")
-			   (with-input-from-string (is "foobarfoobarbaz")
-			     (parse is (seq (rep (seq (lit "foo") (lit "bar")) ) (lit "foo") (lit "bar") (lit "baz")) )
-			     )
-			   )
-	       )
-  (assert-true (node-equal (lit "foo")
-			   (with-input-from-string (is "foo")
-			     (parse is (rep (seq (rep (lit "foo")))) )
-			     )
-			   )
-	       )
-  (assert-true (node-equal (lit "foofoo")
-			   (with-input-from-string (is "foofoo")
-			     (parse is (rep (lit "foo")) )
-			     )
-			   )
-	       )
-  )
-
-(rule simple-capture ()
-      (capture slot1 (lit "foo") )
-      :slots (slot1)
-      )
-
-(rule simple-literal-capture ()
-      (capture slot1 (lit "foo") (lambda (v) (hh-parse::literal v)) )
-      :slots (slot1)
-      )
-
-(define-test capture-test
-  (assert-true (with-input-from-string (is "foo")
-		 (parse is (simple-capture))
-		 )
-	       )
-  (assert-true (node-equal (lit "foo")
-			   (slot-value (with-input-from-string (is "foo")
-					 (parse is (simple-capture))
-					 )
-				       'slot1
-				       )
-			   )
-	       )
-  (assert-true (equal "foo"
-		      (slot-value (with-input-from-string (is "foo")
-				    (parse is (simple-literal-capture))
-				    )
-				  'slot1
-				  )
-		      )
-	       )
-  )
-
-(define-test copy-test
-
-  (let* (
-	 (original (lit "foo") )
-	 (copy (hh-parse::copy-node original) )
-	 )
-    (assert-true (node-equal original copy) )
-    (assert-false (eq original copy) )
-    )
-
-  (let* (
-	 (original (rep (lit "foo")) )
-	 (copy (hh-parse::copy-node original) )
-	 )
-    (assert-true (node-equal original copy) )
-    (assert-false (eq original copy) )
-    )
-
-  (let* (
-	 (original (seq (lit "foo") (lit "bar")) )
-	 (copy (hh-parse::copy-node original) )
-	 )
-    (assert-true (node-equal original copy) )
-    (assert-false (eq original copy) )
-    )
-
-  (let* (
-	 (original (alt (lit "foo") (lit "bar")) )
-	 (copy (hh-parse::copy-node original) )
-	 )
-    (assert-true (node-equal original copy) )
-    (assert-false (eq original copy) )
-    )
-
-  (let* (
-	 (original (opt (lit "foo")) )
-	 (copy (hh-parse::copy-node original) )
-	 )
-    (assert-true (node-equal original copy) )
-    (assert-false (eq original copy) )
-    )
-
-  )
-
-(define-test copy-parser-test
-  (with-input-from-string (is "foobar")
-    (multiple-value-bind (result parser) 
-	(parse is (seq (lit "foo") (lit "bar")) :stop 3)
-      (assert-false result)
-      (assert-true parser)
-      (let (
-	    (new-parser (hh-parse::copy-parser parser) )
-	    )
-	(setf (hh-parse::stop-position-of new-parser) nil)
-	(setf (hh-parse::code new-parser) is)
-	(assert-true (node-equal (lit "foobar")
-				 (hh-parse::parse-input new-parser)
-				 )
-		     )
-	(setf (hh-parse::stop-position-of parser) nil)
-	(assert-true (node-equal (lit "foobar")
-				 (hh-parse::parse-input parser)
-				 )
-		     )
-	)
-      )
-    )
-
-  (with-input-from-string (is "foobar")
-    (multiple-value-bind (result parser) 
-	(parse is (seq (lit "foo") (lit "bar")) :stop 2)
-      (assert-false result)
-      (assert-true parser)
-      (let (
-	    (new-parser (hh-parse::copy-parser parser) )
-	    )
-	(setf (hh-parse::stop-position-of new-parser) nil)
-	(setf (hh-parse::code new-parser) is)
-	(assert-true (node-equal (lit "foobar")
-				 (hh-parse::parse-input new-parser)
-				 )
-		     )
-	(setf (hh-parse::stop-position-of parser) nil)
-	(assert-true (node-equal (lit "foobar")
-				 (hh-parse::parse-input parser)
-				 )
-		     )
-	)
-      )
-    )
-
-  (with-input-from-string (is "foobar")
-    (multiple-value-bind (result parser) 
-	(parse is (seq (lit "foo") (lit "bar")) :stop 4)
-      (assert-false result)
-      (assert-true parser)
-      (let (
-	    (new-parser (hh-parse::copy-parser parser) )
-	    )
-	(setf (hh-parse::stop-position-of new-parser) nil)
-	(setf (hh-parse::code new-parser) is)
-	(assert-true (node-equal (lit "foobar")
-				 (hh-parse::parse-input new-parser)
-				 )
-		     )
-	(setf (hh-parse::stop-position-of parser) nil)
-	(assert-true (node-equal (lit "foobar")
-				 (hh-parse::parse-input parser)
-				 )
-		     )
-	)
-      )
-    )
-
-  )
-
-;; Pseudo-HTML grammar for purposes of testing the parser
-(rule tag-name () (capture
-		   name
-		   (rep (cc #'alpha-char-p)) 
-		   )
-      :slots (name)
-      )
-(rule attribute-name () (rep (cc #'alpha-char-p)) )
-(rule number-value () (seq (opt (lit "-"))
-			   (rep (cc #'digit-char-p)) 
-			   (opt (seq (lit ".") 
-				     (rep (cc #'digit-char-p))
-				     ) 
-				)
-			   )
-      )
-
-(rule quantity-value () (alt (number-value)
-			     (seq (number-value) (lit "%"))
-			     (seq (number-value) (lit "pct"))
-			     (seq (number-value) (lit "px"))
-			     )
-      )
-
-(rule string-value () (alt (seq (lit "\"") (cc #'(lambda (c) (char/= c #\"))) (lit "\"") ) 
-			   (seq (lit "'") (cc #'(lambda (c) (char/= c #\'))) (lit "'") )
-			   )
-      )
-
-(rule attribute-value () (alt (quantity-value)
-			      (string-value)
-			      )
-      )
-
-(rule attribute () (seq (capture name (attribute-name)) (es) (lit "=") (es) (capture value (attribute-value))) 
-      :slots (name value)
-      )
-
-(rule attribute-list () (seq (attribute) (opt (rep (ws) (attribute)) ) ) )
-
-(rule start-tag () (seq (lit "<") (es) (tag-name) (opt (ws) (attribute-list) ) (es) (lit ">") ) )
-(rule end-tag () (seq (lit "<") (es) (lit "/") (es) (tag-name)  (lit ">") ) )
-
-(rule single-tag () (seq (lit "<") (es) (tag-name) (opt (ws) (attribute-list)) (es) (lit "/") (es) (lit ">") ) )
-
-(rule html-text () (rep (cc #'(lambda (c) (char/= c #\<)))) )
-
-(rule tag () (alt (start-tag)
-		  (single-tag)
-		  (seq (start-tag) 
-		       (es) 
-		       (opt (rep
-			     (alt (tag)
-				  (html-text)
-				  )
-			     )
-			    )
-		       (es) 
-		       (end-tag) 
-		       )
-		  )
-      )
-
-(define-test tag-name-parsing-test
-  (assert-true (with-input-from-string (is "foo")
-		 (parse is (rep (cc #'alpha-char-p)))
-		 )
-	       )
-  (assert-true (with-input-from-string (is "foo")
-		 (parse is (tag-name))
-		 )
-	       )
-  (assert-true (node-equal (lit "foo")
-			   (slot-value (with-input-from-string (is "foo")
-					 (parse is (tag-name))
-					 )
-				       'name
-				       )
-			   )
-	       )
-  )
-
-(define-test number-parsing-test
-  (assert-true (with-input-from-string (is "1")
-		 (parse is (number-value) )
-		 )
-	       )
-  (assert-true (with-input-from-string (is "-1")
-		 (parse is (number-value) )
-		 )
-	       )
-  (assert-true (with-input-from-string (is "12")
-		 (parse is (number-value) )
-		 )
-	       )
-  (assert-true (with-input-from-string (is "-12")
-		 (parse is (number-value) )
-		 )
-	       )
-  (assert-true (with-input-from-string (is "1.0")
-		 (parse is (number-value) )
-		 )
-	       )
-  (assert-true (with-input-from-string (is "-1.0")
-		 (parse is (number-value) )
-		 )
-	       )
-  (assert-true (with-input-from-string (is "-12.0")
-		 (parse is (number-value) )
-		 )
-	       )
-  (assert-true (with-input-from-string (is "-1.02")
-		 (parse is (number-value) )
-		 )
-	       )
-  (assert-true (with-input-from-string (is "-12.01")
-		 (parse is (number-value) )
-		 )
-	       )
-  (assert-false (with-input-from-string (is "-12.")
-		 (parse is (number-value) )
-		 )
-	       )
-  (assert-false (with-input-from-string (is "-1.")
-		 (parse is (number-value) )
-		 )
-	       )
-  (assert-false (with-input-from-string (is "-12.0.")
-		 (parse is (number-value) )
-		 )
-	       )
-  )
-
-(define-test tag-parsing-test
-  (assert-true (with-input-from-string (is "<foo>")
-		 (parse is (seq (lit "<") (es) (tag-name) (es) (lit ">") ) )
-		 )
-	       )
-  (assert-false (with-input-from-string (is "foo>")
-		 (parse is (seq (lit "<") (es) (tag-name) (es) (lit ">") ) )
-		 )
-	       )
-  (assert-false (with-input-from-string (is "<foo")
-		 (parse is (seq (lit "<") (es) (tag-name) (es) (lit ">") ) )
-		 )
-	       )
-  (assert-true (with-input-from-string (is "< foo>")
-		 (parse is (seq (lit "<") (es) (tag-name) (es) (lit ">") ) )
-		 )
-	       )
-  (assert-true (with-input-from-string (is "<foo >")
-		 (parse is (seq (lit "<") (es) (tag-name) (es) (lit ">") ) )
-		 )
-	       )
-  (assert-true (with-input-from-string (is "< foo >")
-		 (parse is (seq (lit "<") (es) (tag-name) (es) (lit ">") ) )
-		 )
-	       )
-
-  (assert-true (with-input-from-string (is "<foo>")
-		 (parse is (start-tag) )
-		 )
-	       )
-
-  (assert-true (with-input-from-string (is "</foo>")
-		 (parse is (end-tag) )
-		 )
-	       )
-
-  (assert-true (with-input-from-string (is "<foo/>")
-		 (parse is (single-tag) )
-		 )
-	       )
-
-  (assert-true (with-input-from-string (is "<foo/>")
-		 (parse is (tag) )
-		 )
-	       )
-
-  (assert-true (with-input-from-string (is "<foo></foo>")
-		 (parse is (tag) )
-		 )
-	       )
-  (assert-false (with-input-from-string (is "<foo><foo/>")
-		 (parse is (tag) )
-		 )
-	       )
-  (assert-true (with-input-from-string (is "<foo > < /foo>")
-		 (parse is (tag) )
-		 )
-	       )
-  (assert-true (with-input-from-string (is "<foo>
-</foo>")
-		 (parse is (tag) )
-		 )
-	       )
-  )
-
-(define-test ws-space-parsing-test
-  (assert-true (with-input-from-string (is " foo")
-		 (parse is (seq (ws) (tag-name)) )
-		 )
-	       )
-  (assert-false (with-input-from-string (is "foo")
-		 (parse is (seq (ws) (tag-name)) )
-		 )
-	       )
-  (assert-true (with-input-from-string (is "foo ")
-		 (parse is (seq (tag-name) (ws)) )
-		 )
-	       )
-  (assert-false (with-input-from-string (is "foo")
-		 (parse is (seq (tag-name) (ws)) )
-		 )
-	       )
-  (assert-true (with-input-from-string (is " foo ")
-		 (parse is (seq (ws) (tag-name) (ws)) )
-		 )
-	       )
-  (assert-false (with-input-from-string (is "foo")
-		 (parse is (seq (ws) (tag-name) (ws)) )
-		 )
-	       )
-  )
-
-(define-test es-space-parsing-test
-  (assert-true (with-input-from-string (is " foo")
-		 (parse is (seq (es) (tag-name)) )
-		 )
-	       )
-  (assert-true (with-input-from-string (is "foo")
-		 (parse is (seq (es) (tag-name)) )
-		 )
-	       )
-  (assert-true (with-input-from-string (is "foo ")
-		 (parse is (seq (tag-name) (es)) )
-		 )
-	       )
-  (assert-true (with-input-from-string (is "foo")
-		 (parse is (seq (tag-name) (es)) )
-		 )
-	       )
-  (assert-true (with-input-from-string (is " foo ")
-		 (parse is (seq (es) (tag-name) (es)) )
-		 )
-	       )
-  (assert-true (with-input-from-string (is "foo")
-		 (parse is (seq (es) (tag-name) (es)) )
-		 )
-	       )
-  )
-
-(define-test html-text-test
-  (assert-true (with-input-from-string (is "foo")
-		 (parse is (html-text) )
-		 )
-	       )
-  (assert-false (with-input-from-string (is "foo<")
-		 (parse is (html-text) )
-		 )
-		)
-  (assert-false (with-input-from-string (is "<foo")
-		 (parse is (html-text) )
-		 )
-		)
-  (assert-false (with-input-from-string (is "fo<o")
-		 (parse is (html-text))
-		 )
-		)
-  )
-
-(define-test attribute-test
-  (assert-true (with-input-from-string (is "foo=1")
-		 (parse is (attribute))
-		 )
-	       )
-  (assert-true (with-input-from-string (is "foo =1")
-		 (parse is (attribute) )
-		 )
-	       )
-  (assert-true (with-input-from-string (is "foo= 1")
-		 (parse is (attribute) )
-		 )
-	       )
-  (assert-true (with-input-from-string (is "foo = 1")
-		 (parse is (attribute) )
-		 )
-	       )
-
-  (assert-true (with-input-from-string (is "foo=1")
-		 (parse is (attribute-list))
-		 )
-	       )
-
-  (assert-true (with-input-from-string (is "foo=1 bar=1")
-		 (parse is (attribute-list))
-		 )
-	       )
-  )
-
 ;; =====================================================================================================================
 ;;
 ;; Source tests
 ;;
 ;; =====================================================================================================================
-(define-test source-creation-test
-  (let (
-	(text "hello world!
+(define-test source-code-file-tests
+  (let ((text "hello world!
 ")
-	(src (make-instance 'source-code-file) )
-	)
+	(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) ) )
-    )
-  )
+					    (make-instance 'source-code-position :line 1 :column 0)))
+    (assert-equal 2 (length (lines-of src)))))
 
 (run-tests)