;;;
;;; tests.lisp
;;;
;;; Test suite for parsing smalltalk code.
;;;

;;; FIXME: BSD license header goes here.

(cl:defpackage "SMALLTALK-PARSER-TEST"
  (:use "CL" "SMALLTALK-PARSER" "SB-RT"))

(in-package "SMALLTALK-PARSER-TEST")

(defun collect-test-tokens (input expected-result-length)
  (reset-tokenizer)
  (with-input-from-string
      (*standard-input* input)
    (loop for count from 0 to expected-result-length
	  for token = (get-next-token)
	  while token
	  collect token)))

(defmacro define-tokenizer-test (test-name input expected-result)
  `(deftest ,test-name
    (collect-test-tokens ,input ,(length expected-result))
    ,expected-result))

#+(or) ;; save this one for later.
(define-tokenizer-test parse-error-1
    (handler-case (collect-test-tokens " : " 0)
      (smalltalk-parse-error ()
	t)
      (:no-error ()
	nil))
  t)

(define-tokenizer-test block-arg-1 ":fnord" ((:block-arg "fnord")))

(define-tokenizer-test literal-character-1 "$a" ((:literal #\a)))
(define-tokenizer-test literal-character-2 "$b" ((:literal #\b)))
(define-tokenizer-test literal-character-3 "$^" ((:literal #\^)))

;; #\| is both syntactic and a valid binary selector.  The parser will
;; just have to hack it.
(define-tokenizer-test syntax-1 "|" ((:binary-selector "|")))
(define-tokenizer-test syntax-2 "(" (#\())
(define-tokenizer-test syntax-3 ")" (#\)))
(define-tokenizer-test syntax-4 "^" (#\^))
(define-tokenizer-test syntax-5 "[" (#\[))
(define-tokenizer-test syntax-6 "]" (#\]))
(define-tokenizer-test syntax-7 ";" (#\;))
(define-tokenizer-test syntax-8 "." (#\.))
(define-tokenizer-test syntax-9 "_" (#\_))
(define-tokenizer-test syntax-10 "(|)[];_;.^"
  (#\( (:binary-selector "|") #\) #\[ #\] #\; #\_ #\; #\. #\^))

(define-tokenizer-test binary-selector-1 "-" ((:binary-selector "-")))
(define-tokenizer-test binary-selector-2 "--"
  ((:binary-selector "-") (:binary-selector "-")))
(define-tokenizer-test binary-selector-3 "+" ((:binary-selector "+")))
(define-tokenizer-test binary-selector-4 "++" ((:binary-selector "++")))
(define-tokenizer-test binary-selector-5 "+-"
  ((:binary-selector "+") (:binary-selector "-")))
(define-tokenizer-test binary-selector-6 "/" ((:binary-selector "/")))
(define-tokenizer-test binary-selector-7 "//" ((:binary-selector "//")))
(define-tokenizer-test binary-selector-8 "/+" ((:binary-selector "/+")))
(define-tokenizer-test binary-selector-9 "+/" ((:binary-selector "+/")))
(define-tokenizer-test binary-selector-10 "/-"
  ((:binary-selector "/") (:binary-selector "-")))

(define-tokenizer-test string-1 "''" ((:literal "")))
(define-tokenizer-test string-2 "''''" ((:literal "'")))
(define-tokenizer-test string-3 "'' ''" ((:literal "") (:literal "")))
(define-tokenizer-test string-4 "'fnord!'" ((:literal "fnord!")))
(define-tokenizer-test string-5 "'we''re done'" ((:literal "we're done")))
(define-tokenizer-test string-6 "'string with a \" in it.'"
  ((:literal "string with a \" in it.")))

(define-tokenizer-test identifier-1 "fnord" ((:identifier "fnord")))
(define-tokenizer-test identifier-2 " fnord" ((:identifier "fnord")))
(define-tokenizer-test identifier-3 "hailEris" ((:identifier "hailEris")))
(define-tokenizer-test identifier-4 "test2BeSure" ((:identifier "test2BeSure")))

(define-tokenizer-test keyword-1 "fnord:" ((:keyword "fnord:")))

(define-tokenizer-test comment-1 "\"\"" ())
(define-tokenizer-test comment-2 "\"test\"" ())
(define-tokenizer-test comment-3 "\"\"\"\"" ())
(define-tokenizer-test comment-4 "test \"fnord\" test2"
  ((:identifier "test") (:identifier "test2")))

(define-tokenizer-test symbol-1 "#foo" ((:literal (:symbol "foo"))))
(define-tokenizer-test symbol-2 "#foo:" ((:literal (:symbol "foo:"))))
(define-tokenizer-test symbol-3 "#foo:bar:" ((:literal (:symbol "foo:bar:"))))
(define-tokenizer-test symbol-4 "#==" ((:literal (:symbol "=="))))
(define-tokenizer-test symbol-5 "#= #+"
  ((:literal (:symbol "=")) (:literal (:symbol "+"))))

(define-tokenizer-test number-1 "42" ((:literal (:number 42))))
(define-tokenizer-test number-2 "-5" ((:literal (:number -5))))
(define-tokenizer-test number-3 "16rFF" ((:literal (:number 255))))
(define-tokenizer-test number-4 "16 " ((:literal (:number 16))))

(define-tokenizer-test array-1 "#()" ((:literal (:array))))
(define-tokenizer-test array-2 "#(45 fnord 16rFF)"
  ((:literal (:array (:number 45) (:symbol "fnord") (:number 255)))))
(define-tokenizer-test array-3 "#(fnord:hailEris:)"
  ((:literal (:array (:symbol "fnord:hailEris:")))))
(define-tokenizer-test array-4 "#('fnord' $m)"
  ((:literal (:array "fnord" #\m))))
(define-tokenizer-test array-5 "#('fnord' ($a 57) %~)"
  ((:literal (:array "fnord" (:array #\a (:number 57)) (:symbol "%~")))))

(define-tokenizer-test whole-method-1
    "merge: aRectangle
  | minPoint maxPoint |
  minPoint _ origin min: aRectangle origin.
  maxPoint _ corner max: aRectangle corner.
  ^Rectangle origin: minPoint
             corner: maxPoint"
  ((:keyword "merge:") (:identifier "aRectangle")
   (:binary-selector "|") (:identifier "minPoint")
   (:identifier "maxPoint") (:binary-selector "|")
   (:identifier "minPoint") #\_ (:identifier "origin")
   (:keyword "min:") (:identifier "aRectangle") (:identifier "origin") #\.
   (:identifier "maxPoint") #\_ (:identifier "corner")
   (:keyword "max:") (:identifier "aRectangle") (:identifier "corner") #\.
   #\^ (:identifier "Rectangle") (:keyword "origin:") (:identifier "minPoint")
   (:keyword "corner:") (:identifier "maxPoint")))

(define-tokenizer-test whole-method-2
    "rest
  leftNode isNil
    ifTrue: [^rightNode]
    ifFalse: [leftNode end right: rightNode.
              ^leftNode]"
  ((:identifier "rest") (:identifier "leftNode") (:identifier "isNil")
   (:keyword "ifTrue:") #\[ #\^ (:identifier "rightNode") #\]
   (:keyword "ifFalse:") #\[ (:identifier "leftNode") (:identifier "end")
   (:keyword "right:") (:identifier "rightNode") #\.
   #\^ (:identifier "leftNode") #\]))

(deftest message-pattern-1
    (parse-method-definition "foo")
  ("foo" nil nil nil nil))

(deftest message-pattern-2
    (parse-method-definition "bar")
  ("bar" nil nil nil nil))

(deftest message-pattern-3
    (parse-method-definition "foo: bar")
  ("foo:" ("bar") nil nil nil))

(deftest message-pattern-4
    (parse-method-definition "= foo")
  ("=" ("foo") nil nil nil))

(deftest message-pattern-5
    (parse-method-definition "foo: bar baz: quux")
  ("foo:baz:" ("bar" "quux") nil nil nil))

(deftest message-pattern-6
    (parse-method-definition "isMemberOf: aClass ^self class == aClass")
  ("isMemberOf:" ("aClass") nil nil ((#\^ ("==" ("class" (:identifier "self")) (:identifier "aClass"))))))

(deftest statement-1
    (parse-method-definition "isNil ^false")
  ("isNil" nil nil nil ((#\^ (:identifier "false")))))

(deftest statement-2
    (parse-method-definition "foo ^42")
  ("foo" nil nil nil ((#\^ (:literal (:number 42))))))

(deftest statement-3
    (parse-method-definition "foo 3")
  ("foo" nil nil nil ((:literal (:number 3)))))

(deftest statement-4
    (parse-method-definition "foo 3. 4")
  ("foo" nil nil nil ((:literal (:number 3))
		      (:literal (:number 4)))))

(deftest statement-5
    (parse-method-definition "foo 3. 4. 5")
  ("foo" nil nil nil ((:literal (:number 3))
		      (:literal (:number 4))
		      (:literal (:number 5)))))

(deftest statement-6
    (parse-method-definition "foo 3. ^4")
  ("foo" nil nil nil ((:literal (:number 3))
		      (#\^ (:literal (:number 4))))))

(deftest temporary-1
    (parse-method-definition "foo | bar |")
  ("foo" nil nil ("bar") nil))

(deftest temporary-2
    (parse-method-definition "foo | bar | ^true")
  ("foo" nil nil ("bar") ((#\^ (:identifier "true")))))

(deftest primitive-1
    (parse-method-definition "+ addend <primitive: 1>")
  ("+" ("addend") 1 nil nil))

(deftest primitive-2
    (parse-method-definition "+ addend <primitive: 1> | foo |")
  ("+" ("addend") 1 ("foo") nil))

(deftest primitive-3
    (parse-method-definition "+ addend <primitive: 1> ^super + addend")
  ("+" ("addend") 1 nil
    ((#\^ ("+" (:identifier "super") (:identifier "addend"))))))

(deftest subexperssion-1
    (parse-method-definition "foo 1 + 2 + 3")
  ("foo" nil nil nil (("+" ("+" (:literal (:number 1)) (:literal (:number 2))) (:literal (:number 3))))))

(deftest subexpression-2
    (parse-method-definition "foo (1 + 2) + 3")
  ("foo" nil nil nil (("+" ("+" (:literal (:number 1)) (:literal (:number 2))) (:literal (:number 3))))))

(deftest subexpression-3
    (parse-method-definition "foo 1 + (2 + 3)")
  ("foo" nil nil nil (("+" (:literal (:number 1)) ("+" (:literal (:number 2)) (:literal (:number 3)))))))

(deftest expression-1
    (parse-method-definition "foo 1 isNil + 32")
  ("foo" nil nil nil (("+" ("isNil" (:literal (:number 1))) (:literal (:number 32))))))

(deftest expression-2
    (parse-method-definition "foo 1 isNil isNil + 32")
  ("foo" nil nil nil (("+" ("isNil" ("isNil" (:literal (:number 1)))) (:literal (:number 32))))))

(deftest expression-3
    (parse-method-definition "foo 1 + 32 isNil")
  ("foo" nil nil nil (("+" (:literal (:number 1)) ("isNil" (:literal (:number 32)))))))

(deftest expression-4
    (parse-method-definition "foo 1 + 32 isNil isNil")
  ("foo" nil nil nil (("+" (:literal (:number 1)) ("isNil" ("isNil" (:literal (:number 32))))))))

(deftest keyword-expression-1
    (parse-method-definition "foo 1 bitShift: 2")
  ("foo" nil nil nil (("bitShift:" (:literal (:number 1)) (:literal (:number 2))))))

(deftest keyword-expression-2
    (parse-method-definition "foo 1 bitShift: 2 bitShift: 3")
  ("foo" nil nil nil (("bitShift:bitShift:" (:literal (:number 1)) (:literal (:number 2)) (:literal (:number 3))))))

(deftest keyword-expression-3
    (parse-method-definition "foo 3 + 4 bar: baz @ quux frob")
  ("foo" nil nil nil (("bar:" ("+" (:literal (:number 3)) (:literal (:number 4))) ("@" (:identifier "baz") ("frob" (:identifier "quux")))))))

(deftest assignment-1
    (parse-method-definition "foo bar _ baz")
  ("foo" nil nil nil ((#\_ (:identifier "bar") (:identifier "baz")))))

(deftest assignment-2
    (parse-method-definition "foo bar _ baz _ quux")
  ("foo" nil nil nil ((#\_ (:identifier "bar") (#\_ (:identifier "baz") (:identifier "quux"))))))

(deftest block-1
    (parse-method-definition "foo ^[]")
  ("foo" nil nil nil ((#\^ (:block nil nil)))))

(deftest block-2
    (parse-method-definition "foo []. ^nil")
  ("foo" nil nil nil ((:block nil nil) (#\^ (:identifier "nil")))))

(deftest block-3
    (parse-method-definition "foo [ bar ]")
  ("foo" nil nil nil ((:block nil ((:identifier "bar"))))))

(deftest block-4
    (parse-method-definition "foo [ bar. ^baz ]")
  ("foo" nil nil nil ((:block nil ((:identifier "bar") (#\^ (:identifier "baz")))))))

(deftest block-5
    (parse-method-definition "foo [ :bar | ]")
  ("foo" nil nil nil ((:block ("bar") nil))))

(deftest block-6
    (parse-method-definition "foo [ :bar | 'baz' ]")
  ("foo" nil nil nil ((:block ("bar") ((:literal "baz"))))))

(deftest block-7
    (parse-method-definition "foo [ :bar :baz | ]")
  ("foo" nil nil nil ((:block ("bar" "baz") nil))))

;;; EOF
