increase test coverage to include vfs and <pre>

This commit is contained in:
Simon Cruanes 2022-03-17 22:34:50 -04:00
parent 7fdb420eb0
commit 6706589c62
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
8 changed files with 99 additions and 14 deletions

View file

@ -116,16 +116,23 @@ let () =
(* main page *)
S.add_route_handler server S.Route.(return)
(fun _req ->
let s = "<head></head><body>\n\
<p><b>welcome!</b>\n<p>endpoints are:\n<ul>\
<li><pre>/hello/'name' (GET)</pre></li>\n\
<li><pre><a href=\"/echo/\">/echo/</a> (GET) echoes back query</pre></li>\n\
<li><pre>/upload/'path' (PUT) to upload a file</pre></li>\n\
<li><pre>/zcat/'path' (GET) to download a file (compressed)</pre></li>\n\
<li><pre>/stats/ (GET) to access statistics</pre></li>\n\
<li><pre><a href=\"/vfs/\">/vfs/</a> (GET) to access a VFS embedded in the binary</pre></li>\n\
</ul></body>"
in
let open Tiny_httpd_html in
let h = html [] [
head[][title[][txt "index of echo"]];
body[][
h3[] [txt "welcome!"];
p[] [b[] [txt "endpoints are:"]];
ul[] [
li[][pre[][txt "/hello/:name (GET)"]];
li[][pre[][a[A.href "/echo/"][txt "echo"]; txt " echo back query"]];
li[][pre[][txt "/upload/:path (PUT) to upload a file"]];
li[][pre[][txt "/zcat/:path (GET) to download a file (deflate transfer-encoding)"]];
li[][pre[][a[A.href "/stats/"][txt"/stats/"]; txt" (GET) to access statistics"]];
li[][pre[][a[A.href "/vfs/"][txt"/vfs"]; txt" (GET) to access a VFS embedded in the binary"]];
]
]
] in
let s = to_string_top h in
S.Response.make_string ~headers:["content-type", "text/html"] @@ Ok s);
Printf.printf "listening on http://%s:%d\n%!" (S.addr server) (S.port server);

View file

@ -57,7 +57,6 @@
(enabled_if (= %{system} "linux"))
(action (diff dl-out.expect dl-out)))
(rule
(targets foo_50)
(enabled_if (= %{system} "linux"))

View file

@ -7,3 +7,65 @@ echo:
path="/echo/?a=b&c=d"; body=""; path_components=["echo"];
query=["c","d";"a","b"]}
(query: "c" = "d";"a" = "b")
<!DOCTYPE html>
<html>
<head>
<title>
list directory &quot;Embedded_fs&quot;
</title>
<meta charset="utf-8"/>
</head>
<body>
<h2>
Index of &quot;&quot;
</h2>
<ul>
<li>
<a href="/vfs/a.txt">
a.txt
</a>
(12b)</li>
<li>
<a href="/vfs/example_dot_com">
example_dot_com
</a>
(1.12k)</li>
<li>
<a href="/vfs/foo.html">
foo.html
</a>
(214b)</li>
<li>
<a href="/vfs/sub">
sub
</a>
[dir]</li>
<li>
<a href="/vfs/test_out.txt">
test_out.txt
</a>
(209b)</li>
</ul>
</body>
</html>
hello
world
<html>
<head>
</head>
<body>
<h2> funky: </h2>
<ul>
<li>
<a href="../"> go up!! </a>
</li>
<li>
<a href="../foo.html"> up/foo </a>
</li>
</ul>
</body>
</html>

View file

@ -7,4 +7,14 @@ PORT=8085
PID=$!
sleep 0.1
curl -N "http://localhost:${PORT}/echo/?a=b&c=d" -H user-agent:test
sleep 0.1
curl -N "http://localhost:${PORT}/vfs/"
sleep 0.1
curl -N "http://localhost:${PORT}/vfs/a.txt"
sleep 0.1
curl -N "http://localhost:${PORT}/vfs/sub/yolo.html"
kill $PID

View file

@ -6,6 +6,7 @@ let t1() =
head [] [];
body [] [
ul [A.style "list-style: circle"] (
li[][pre [] [txt "a"; txt "b"]] ::
List.init 100 (fun i -> li [A.id (spf "l%d" i)] [txt (spf "item %d" i)])
)
]
@ -15,10 +16,11 @@ let t1() =
let t2() =
html [] [
head [] [];
pre [] [txt "a"; txt "b"];
body [] [
ul' [A.style "list-style: circle"] (fun buf ->
ul' [A.style "list-style: circle"] (fun out ->
for i=0 to 99 do
li ~if_:(i<> 42) [A.id (spf "l%d" i)] [txt (spf "item %d" i)] buf
li ~if_:(i<> 42) [A.id (spf "l%d" i)] [txt (spf "item %d" i)] out
done
)
]

View file

@ -5,6 +5,10 @@
<body>
<ul style="list-style: circle">
<li>
<pre>ab</pre>
</li>
<li id="l0">
item 0
</li>

View file

@ -3,6 +3,7 @@
<head>
</head>
<pre>ab</pre>
<body>
<ul style="list-style: circle">
<li id="l0">

View file

@ -1,2 +1,2 @@
serve directory . on http://127.0.0.1:8087
upload successful 0 0 52428800 data
server error: Invalid_argument("Bytes.blit")0 0 0 data