(module command-test mzscheme
(require (all-except (lib "list.ss" "srfi" "1") any)
(lib "cut.ss" "srfi" "26"))
(require (file "command.ss")
(file "core.ss")
(file "selector.ss")
(file "test-base.ss"))
(define command-tests
(test-suite "command.ss"
(test-case "click, click/wait"
(let ([request-box (box #f)])
(open/wait (lambda (request)
(send/suspend/dispatch
(lambda (embed-url)
`(html (head (title "Test form"))
(body (form ([method "POST"]
[action ,(embed-url (lambda (request)
(set-box! request-box request)
(send/back '(html (body (p "Submitted"))))))])
,@(map (lambda (num)
`(div "Box " ,(number->string num)
(input ([id ,(format "box~a" num)]
[name ,(format "box~a" num)]
[class "checkbox"]
[type "checkbox"]))))
(iota 3))
(input ([id "submit"]
[name "submit"]
[type "submit"])))))))))
(click (node/id 'box1))
(click/wait (node/id 'submit))
(let ([bindings (request-bindings (unbox request-box))])
(check-false (exists-binding? 'box0 bindings) "check 1")
(check-true (exists-binding? 'box1 bindings) "check 2")
(check-false (exists-binding? 'box2 bindings) "check 3"))))
(test-case "click, select, type and click/wait"
(let ([request-box (box #f)])
(open/wait (lambda (request)
(send/suspend/dispatch
(lambda (embed-url)
`(html (head (title "Test form"))
(body (form ([method "POST"]
[action ,(embed-url (lambda (request)
(set-box! request-box request)
(send/back '(html (body (p "Submitted"))))))])
(input ([id "check-box"] [name "check-box"] [type "checkbox"]))
(select ([id "select"] [name "select"])
(option ([value "value1"]) "Value 1")
(option ([value "value2"]) "Value 2")
(option ([value "value3"]) "Value 3"))
(input ([id "text-field"] [name "text-field"] [type "text"]))
(input ([id "submit"] [name "submit"] [type "submit"])))))))))
(click (node/id 'check-box))
(select (node/id 'select) "value2")
(type (node/id 'text-field) "Sample text")
(check-exn exn:fail:delirium? (cut click (node/id 'does-not-exist)))
(check-exn exn:fail:delirium? (cut select (node/id 'does-not-exist) "value"))
(check-exn exn:fail:delirium? (cut type (node/id 'does-not-exist) "Text"))
(click/wait (node/id 'submit))
(let ([bindings (request-bindings (unbox request-box))])
(check-true (exists-binding? 'check-box bindings) "check 1")
(check-true (exists-binding? 'select bindings) "check 2")
(check-equal? (extract-binding/single 'select bindings) "value2" "check 3")
(check-true (exists-binding? 'text-field bindings) "check 4")
(check-equal? (extract-binding/single 'text-field bindings) "Sample text" "check 5"))))
(test-case
"click*, select*, type*, and click/wait*"
(let ([request-box (box #f)])
(open/wait (lambda (request)
(send/suspend/dispatch
(lambda (embed-url)
`(html (head (title "Test form"))
(body (form ([method "POST"]
[action ,(embed-url (lambda (request)
(set-box! request-box request)
(send/back '(html (body (p "Submitted"))))))])
(input ([id "check-box1"] [name "check-box1"] [type "checkbox"]))
(input ([id "check-box2"] [name "check-box2"] [type "checkbox"]))
(select ([id "select1"] [name "select1"])
(option ([value "value1"]) "Value 1")
(option ([value "value2"]) "Value 2")
(option ([value "value3"]) "Value 3"))
(select ([id "select2"] [name "select2"])
(option ([value "value1"]) "Value 1")
(option ([value "value2"]) "Value 2")
(option ([value "value3"]) "Value 3"))
(input ([id "text-field1"] [name "text-field1"] [type "text"]))
(input ([id "text-field2"] [name "text-field2"] [type "text"]))
(input ([id "submit"] [name "submit"] [type "submit"])))))))))
(click* (node/xpath "//input[@type='checkbox']"))
(select* (node/xpath "//select") 'value2)
(type* (node/xpath "//input[@type='text']") "Sample text")
(check-exn exn:fail:delirium? (cut click* (node/id 'does-not-exist)))
(check-exn exn:fail:delirium? (cut select* (node/id 'does-not-exist) "value"))
(check-exn exn:fail:delirium? (cut type* (node/id 'does-not-exist) "Text"))
(click*/wait (node/id 'submit))
(let ([bindings (request-bindings (unbox request-box))])
(check-true (exists-binding? 'check-box1 bindings) "check-box1")
(check-true (exists-binding? 'check-box2 bindings) "check-box2")
(check-true (exists-binding? 'select1 bindings) "select1")
(check-true (exists-binding? 'select2 bindings) "select2")
(check-equal? (extract-binding/single 'select1 bindings) "value2" "select1 value")
(check-equal? (extract-binding/single 'select2 bindings) "value2" "select2 value")
(check-true (exists-binding? 'text-field1 bindings) "text-field1")
(check-true (exists-binding? 'text-field2 bindings) "text-field2")
(check-equal? (extract-binding/single 'text-field1 bindings) "Sample text" "text-field2 value")
(check-equal? (extract-binding/single 'text-field2 bindings) "Sample text" "text-field1 value"))))
))
(provide command-tests)
)