diff options
Diffstat (limited to 'test/test_server.f90')
| -rw-r--r-- | test/test_server.f90 | 214 |
1 files changed, 214 insertions, 0 deletions
diff --git a/test/test_server.f90 b/test/test_server.f90 new file mode 100644 index 0000000..bb8cb0c --- /dev/null +++ b/test/test_server.f90 @@ -0,0 +1,214 @@ +!> Fortran side of the suite's local HTTP server. +!> +!> The server itself is `test/http_server.c`, compiled and linked with the +!> tests. Everything here is a thin `iso_c_binding` wrapper that takes and +!> returns ordinary Fortran strings. +module test_server + use, intrinsic :: iso_c_binding + use cepis_strings, only: to_c_chars, from_integer + use, intrinsic :: iso_fortran_env, only: int64 + implicit none + private + + public :: server_start + public :: server_stop + public :: server_reset + public :: server_base_url + public :: server_respond + public :: server_respond_more + public :: server_respond_default + public :: server_count + public :: server_total + public :: server_path + + interface + function ts_start() bind(c, name='ts_start') result(handle) + import :: c_ptr + type(c_ptr) :: handle + end function ts_start + + subroutine ts_stop(handle) bind(c, name='ts_stop') + import :: c_ptr + type(c_ptr), value :: handle + end subroutine ts_stop + + subroutine ts_reset(handle) bind(c, name='ts_reset') + import :: c_ptr + type(c_ptr), value :: handle + end subroutine ts_reset + + function ts_port(handle) bind(c, name='ts_port') result(port) + import :: c_ptr, c_int + type(c_ptr), value :: handle + integer(c_int) :: port + end function ts_port + + subroutine ts_respond(handle, path, status, body, headers) & + bind(c, name='ts_respond') + import :: c_ptr, c_char, c_long + type(c_ptr), value :: handle + character(kind=c_char), intent(in) :: path(*) + integer(c_long), value :: status + character(kind=c_char), intent(in) :: body(*) + character(kind=c_char), intent(in) :: headers(*) + end subroutine ts_respond + + subroutine ts_respond_more(handle, path, status, body, headers) & + bind(c, name='ts_respond_more') + import :: c_ptr, c_char, c_long + type(c_ptr), value :: handle + character(kind=c_char), intent(in) :: path(*) + integer(c_long), value :: status + character(kind=c_char), intent(in) :: body(*) + character(kind=c_char), intent(in) :: headers(*) + end subroutine ts_respond_more + + subroutine ts_respond_default(handle, status, body, headers) & + bind(c, name='ts_respond_default') + import :: c_ptr, c_char, c_long + type(c_ptr), value :: handle + integer(c_long), value :: status + character(kind=c_char), intent(in) :: body(*) + character(kind=c_char), intent(in) :: headers(*) + end subroutine ts_respond_default + + function ts_count(handle, prefix) bind(c, name='ts_count') result(total) + import :: c_ptr, c_char, c_size_t + type(c_ptr), value :: handle + character(kind=c_char), intent(in) :: prefix(*) + integer(c_size_t) :: total + end function ts_count + + function ts_total(handle) bind(c, name='ts_total') result(total) + import :: c_ptr, c_size_t + type(c_ptr), value :: handle + integer(c_size_t) :: total + end function ts_total + + function ts_path_length(handle, index) bind(c, name='ts_path_length') result(length) + import :: c_ptr, c_size_t + type(c_ptr), value :: handle + integer(c_size_t), value :: index + integer(c_size_t) :: length + end function ts_path_length + + subroutine ts_path_copy(handle, index, out, out_size) & + bind(c, name='ts_path_copy') + import :: c_ptr, c_char, c_size_t + type(c_ptr), value :: handle + integer(c_size_t), value :: index + character(kind=c_char), intent(inout) :: out(*) + integer(c_size_t), value :: out_size + end subroutine ts_path_copy + end interface + +contains + + !> Start a server on a random loopback port. `c_null_ptr` on failure. + function server_start() result(handle) + type(c_ptr) :: handle + + handle = ts_start() + end function server_start + + subroutine server_stop(handle) + type(c_ptr), intent(in) :: handle + + call ts_stop(handle) + end subroutine server_stop + + !> Forget every route and every recorded request. + subroutine server_reset(handle) + type(c_ptr), intent(in) :: handle + + call ts_reset(handle) + end subroutine server_reset + + !> `http://127.0.0.1:PORT`. + function server_base_url(handle) result(url) + type(c_ptr), intent(in) :: handle + character(len=:), allocatable :: url + + url = 'http://127.0.0.1:'//from_integer(int(ts_port(handle), int64)) + end function server_base_url + + !> Register the only reply for `path`, replacing any previous route. + subroutine server_respond(handle, path, status, body, headers) + type(c_ptr), intent(in) :: handle + character(len=*), intent(in) :: path + integer, intent(in) :: status + character(len=*), intent(in) :: body + character(len=*), intent(in) :: headers + + call ts_respond(handle, to_c_chars(path), int(status, c_long), & + to_c_chars(body), to_c_chars(headers)) + end subroutine server_respond + + !> Append another reply to `path`. Each request consumes the next entry; + !> the last one repeats once the queue runs out. This is how retrying is + !> tested. + subroutine server_respond_more(handle, path, status, body, headers) + type(c_ptr), intent(in) :: handle + character(len=*), intent(in) :: path + integer, intent(in) :: status + character(len=*), intent(in) :: body + character(len=*), intent(in) :: headers + + call ts_respond_more(handle, to_c_chars(path), int(status, c_long), & + to_c_chars(body), to_c_chars(headers)) + end subroutine server_respond_more + + !> The reply for any path with no explicit route. Used where the request + !> path is thousands of characters long and matching it buys nothing. + subroutine server_respond_default(handle, status, body, headers) + type(c_ptr), intent(in) :: handle + integer, intent(in) :: status + character(len=*), intent(in) :: body + character(len=*), intent(in) :: headers + + call ts_respond_default(handle, int(status, c_long), to_c_chars(body), & + to_c_chars(headers)) + end subroutine server_respond_default + + !> How many requests so far had a path starting with `prefix`. + function server_count(handle, prefix) result(total) + type(c_ptr), intent(in) :: handle + character(len=*), intent(in) :: prefix + integer :: total + + total = int(ts_count(handle, to_c_chars(prefix))) + end function server_count + + !> How many requests the server has served in total. + function server_total(handle) result(total) + type(c_ptr), intent(in) :: handle + integer :: total + + total = int(ts_total(handle)) + end function server_total + + !> The path of request `index`, counting from one. Empty when there is no + !> such request. + function server_path(handle, index) result(path) + type(c_ptr), intent(in) :: handle + integer, intent(in) :: index + character(len=:), allocatable :: path + character(kind=c_char), allocatable :: buffer(:) + integer :: length, i + + length = int(ts_path_length(handle, int(index - 1, c_size_t))) + if (length <= 0) then + path = '' + return + end if + + allocate (buffer(length + 1)) + call ts_path_copy(handle, int(index - 1, c_size_t), buffer, & + int(length + 1, c_size_t)) + allocate (character(len=length) :: path) + do i = 1, length + path(i:i) = buffer(i) + end do + end function server_path + +end module test_server |