Fixing problem reported by Robby.
Contracts intefere with safety marks.
This commit is contained in:
parent
ab5a9ff1e8
commit
4f49658835
|
@ -161,4 +161,18 @@
|
||||||
"Quiz Results")
|
"Quiz Results")
|
||||||
|
|
||||||
; XXX test web-extras.rkt - redirect/get
|
; XXX test web-extras.rkt - redirect/get
|
||||||
|
|
||||||
|
(let* ([x (random 500)]
|
||||||
|
[xs (string->bytes/utf-8 (number->string x))]
|
||||||
|
[y (random 500)]
|
||||||
|
[ys (string->bytes/utf-8 (number->string y))])
|
||||||
|
(test-equal?
|
||||||
|
"redirectget.rkt"
|
||||||
|
(let* ([d (mkd (build-path example-servlets "redirectget.rkt"))]
|
||||||
|
[k0 (simple-xpath* '(form #:action) (call d url0 empty))]
|
||||||
|
[k1 (call d k0 empty)])
|
||||||
|
k1)
|
||||||
|
""))
|
||||||
|
|
||||||
|
|
||||||
))
|
))
|
||||||
|
|
|
@ -0,0 +1,17 @@
|
||||||
|
#lang web-server
|
||||||
|
(define interface-version 'stateless)
|
||||||
|
(provide start interface-version)
|
||||||
|
|
||||||
|
(define (start request)
|
||||||
|
(define request
|
||||||
|
(send/suspend
|
||||||
|
(λ (url)
|
||||||
|
`(html
|
||||||
|
(head)
|
||||||
|
(body
|
||||||
|
(form ((action ,url))
|
||||||
|
(input ((type "submit") (value "submit")))))))))
|
||||||
|
(redirect/get)
|
||||||
|
(send/suspend
|
||||||
|
(λ (_)
|
||||||
|
`(html "bye"))))
|
|
@ -21,7 +21,8 @@
|
||||||
send/suspend/dispatch
|
send/suspend/dispatch
|
||||||
send/suspend/hidden
|
send/suspend/hidden
|
||||||
send/suspend/url
|
send/suspend/url
|
||||||
send/suspend/url/dispatch)
|
send/suspend/url/dispatch
|
||||||
|
redirect/get)
|
||||||
|
|
||||||
(provide/contract
|
(provide/contract
|
||||||
[make-stateless-servlet
|
[make-stateless-servlet
|
||||||
|
@ -37,7 +38,8 @@
|
||||||
[send/suspend/hidden ((url? list? . -> . response/c) . -> . request?)]
|
[send/suspend/hidden ((url? list? . -> . response/c) . -> . request?)]
|
||||||
[send/suspend/url ((url? . -> . response/c) . -> . request?)]
|
[send/suspend/url ((url? . -> . response/c) . -> . request?)]
|
||||||
[send/suspend/url/dispatch ((((request? . -> . any/c) . -> . url?) . -> . response/c)
|
[send/suspend/url/dispatch ((((request? . -> . any/c) . -> . url?) . -> . response/c)
|
||||||
. -> . any/c)])
|
. -> . any/c)]
|
||||||
|
[redirect/get (-> request?)])
|
||||||
|
|
||||||
;; initial-servlet : (request -> response) -> (request -> response/c)
|
;; initial-servlet : (request -> response) -> (request -> response/c)
|
||||||
(define (initialize-servlet start)
|
(define (initialize-servlet start)
|
||||||
|
@ -115,8 +117,5 @@
|
||||||
(read (open-input-bytes kont)))]
|
(read (open-input-bytes kont)))]
|
||||||
[_ #f])))
|
[_ #f])))
|
||||||
|
|
||||||
(provide/contract
|
|
||||||
[redirect/get (-> request?)])
|
|
||||||
|
|
||||||
(define (redirect/get)
|
(define (redirect/get)
|
||||||
(send/suspend/url (lambda (k-url) (redirect-to (url->string k-url) temporarily))))
|
(send/suspend/url (lambda (k-url) (redirect-to (url->string k-url) temporarily))))
|
||||||
|
|
Loading…
Reference in New Issue
Block a user