drdr found a 'test suite' that didnt actually have expected results, so I added in expected results and fixed a few bugs that it uncovered

svn: r16362

original commit: 2064861baa303b33fa49b92401d78fb2d363b9cc

collects/parser-tools/lex.ss

@@ -93,6 +93,8 @@
 					       name))
 				       re-act-lst
 				       name-lst)))
+             (when (null? spec/re-act-lst)
+               (raise-syntax-error (if src-pos? 'lexer/src-pos 'lexer) "expected at least one action" stx))
              (let-values (((trans start action-names no-look disappeared-uses)
                            (build-lexer re-actname-lst)))
                (when (vector-ref action-names start) ;; Start state is final
@@ -185,10 +187,16 @@
       ((_ name-form body-form)
        (let-values (((name body)
                      (normalize-definition (syntax (define-syntax name-form body-form)) #'lambda)))
+         
          #`(define-syntax #,name 
-             (let ((certifier (syntax-local-certifier)))
+             (let ((certifier (syntax-local-certifier))
+                   (func #,body))
+               (unless (procedure? func)
+                 (raise-syntax-error 'define-lex-trans "expected a procedure as the transformer, got ~e" func))
+               (unless (procedure-arity-includes? func 1)
+                 (raise-syntax-error 'define-lex-trans "expected a procedure that accepts 1 argument as the transformer, got ~e" func))
                (make-lex-trans (lambda (stx)
-                                 (certifier (#,body stx) 'a)))))))
+                                 (certifier (func stx) 'a)))))))
       (_
        (raise-syntax-error
         #f

collects/parser-tools/private-lex/error-tests.ss

@@ -1,35 +1,52 @@
-(define-lex-abbrev)
-(define-lex-abbrev a)
-(define-lex-abbrev (a b) v)
-(define-lex-abbrev 1 1)
-(define-lex-abbrevs ())
-
-(define-lex-trans)
-(define-lex-trans (1 b) 1)
-
-(lexer)
-(lexer ("a" "b" "c"))
-(lexer ())
-(lexer (""))
-
-(lexer (a 1))
-(lexer ((a) 1))
-(let ((a 1))
-  (lexer ((a) 1)))
-(let-syntax ((a 1))
-  (lexer ((a) 1)))
-(let ()
+#lang scheme/base
+(require (for-syntax scheme/base)
+         "../lex.ss"
+         schemeunit)
+
+(define-syntax (catch-syn-error stx)
+  (syntax-case stx ()
+    [(_ arg)
+     (datum->syntax
+      #'here
+      (with-handlers ((exn:fail:syntax? exn-message))
+        (syntax-local-expand-expression  #'arg)
+        "not-an-error"))]))
+
+(check-regexp-match #rx"lex-abbrev" (catch-syn-error (define-lex-abbrev)))
+(check-regexp-match #rx"lex-abbrev" (catch-syn-error (define-lex-abbrev a)))
+(check-regexp-match #rx"lex-abbrev" (catch-syn-error (define-lex-abbrev (a b) v)))
+(check-regexp-match #rx"lex-abbrev" (catch-syn-error (define-lex-abbrev 1 1)))
+(check-regexp-match #rx"lex-abbrevs" (catch-syn-error (define-lex-abbrevs ())))
+
+(check-regexp-match #rx"lex-trans" (catch-syn-error (define-lex-trans)))
+
+(check-regexp-match #rx"lexer" (catch-syn-error (lexer)))
+(check-regexp-match #rx"lexer" (catch-syn-error (lexer ("a" "b" "c"))))
+(check-regexp-match #rx"lexer" (catch-syn-error (lexer ())))
+(check-regexp-match #rx"lexer" (catch-syn-error (lexer (""))))
+
+(check-regexp-match #rx"regular-expression" (catch-syn-error (lexer (a 1))))
+(check-regexp-match #rx"regular-expression" (catch-syn-error (lexer ((a) 1))))
+(check-regexp-match #rx"regular-expression" (catch-syn-error (let ((a 1)) (lexer ((a) 1)))))
+
+(check-regexp-match #rx"regular-expression"
+                    (catch-syn-error (let-syntax ((a 1))
+                                       (lexer ((a) 1)))))
+
+(check-regexp-match #rx"define-lex-trans"
+                    (catch-syn-error 
+                     (let ()
                        (define-lex-trans a 1)
                        (let ()
-    (lexer ((a) 1))))
-
-(lexer (1 1))
-(lexer ((repetition) 1))
-(lexer ((repetition #\1 #\1 "3") 1))
-(lexer ((repetition 1 #\1 "3") 1))
-(lexer ((repetition 1 0 "3") 1))
-(lexer ((complement) 1))
-(lexer ((char-range) 1))
-(lexer ((char-range #\9 #\0) 1))
-(lexer ((char-complement) 1))
-(lexer ((char-complement (concatenation "1" "2")) 1))
+                         (lexer ((a) 1))))))
+
+(check-regexp-match #rx"regular-expression" (catch-syn-error (lexer (1 1))))
+(check-regexp-match #rx"repetition" (catch-syn-error (lexer ((repetition) 1))))
+(check-regexp-match #rx"repetition" (catch-syn-error (lexer ((repetition #\1 #\1 "3") 1))))
+(check-regexp-match #rx"repetition" (catch-syn-error (lexer ((repetition 1 #\1 "3") 1))))
+(check-regexp-match #rx"repetition" (catch-syn-error (lexer ((repetition 1 0 "3") 1))))
+(check-regexp-match #rx"complement" (catch-syn-error (lexer ((complement) 1))))
+(check-regexp-match #rx"char-range" (catch-syn-error (lexer ((char-range) 1))))
+(check-regexp-match #rx"char-range" (catch-syn-error (lexer ((char-range #\9 #\0) 1))))
+(check-regexp-match #rx"char-complement" (catch-syn-error (lexer ((char-complement) 1))))
+(check-regexp-match #rx"char-complement" (catch-syn-error (lexer ((char-complement (concatenation "1" "2")) 1))))