diff options
Diffstat (limited to 'test/test_cepis.f90')
| -rw-r--r-- | test/test_cepis.f90 | 886 |
1 files changed, 886 insertions, 0 deletions
diff --git a/test/test_cepis.f90 b/test/test_cepis.f90 new file mode 100644 index 0000000..348e9df --- /dev/null +++ b/test/test_cepis.f90 @@ -0,0 +1,886 @@ +!> The suite. +!> +!> Every client test points `base_url` at a real HTTP server on loopback, so +!> the code path exercised is the one that runs in production, libcurl and all. +!> The parsers are also driven directly, with long and quoted values, because +!> silent truncation is the failure mode a hand-written Fortran parser is most +!> likely to have. +program test_cepis + use, intrinsic :: iso_c_binding, only: c_ptr, c_associated + use, intrinsic :: iso_fortran_env, only: real64, int64, output_unit + use cepis + use cepis_strings + use cepis_json + use cepis_csv + use cepis_http, only: http_parse_retry_after + use test_server + implicit none + + character(len=:), allocatable :: SE, PAULISTA, CITYWIDE, CSV_HEADER, HEALTH_BODY + integer :: passed, failed + type(c_ptr) :: server + character(len=:), allocatable :: base + + passed = 0 + failed = 0 + call build_fixtures() + + server = server_start() + if (.not. c_associated(server)) then + write (output_unit, '(A)') 'could not start the test server' + stop 1 + end if + base = server_base_url(server) + + call test_normalize_accepts_masked_and_unmasked() + call test_normalize_rejects_bad_format() + call test_format_cep() + call test_json_reads_long_values_without_truncation() + call test_json_decodes_escapes_and_surrogates() + call test_json_rejects_garbage() + call test_csv_reads_quoted_and_long_values() + call test_csv_reads_crlf_and_bom() + call test_retry_after_parses_both_forms() + + call test_successful_lookup() + call test_reads_the_coordinate_when_present() + call test_municipality_coordinate_is_not_precise() + call test_malformed_geo_does_not_lose_the_address() + call test_new_api_field_does_not_break() + call test_not_found_is_not_retried() + call test_invalid_cep_never_leaves_the_machine() + call test_api_400_becomes_invalid_cep() + call test_response_that_is_not_json() + call test_retries_on_500_then_succeeds() + call test_exhausts_attempts_then_fails() + call test_max_attempts_one_disables_retry() + call test_429_becomes_rate_limited_with_retry_after() + call test_retry_after_http_date_is_understood() + call test_retry_after_honours_the_cap() + call test_network_error_when_nothing_listens() + call test_total_timeout_bounds_the_whole_call() + call test_batch_preserves_order_and_marks_missing() + call test_batch_field_with_comma_is_parsed() + call test_batch_empty_list_makes_no_request() + call test_batch_chunks_above_the_api_limit() + call test_batch_truncated_response_does_not_shift() + call test_batch_malformed_cep_is_not_found() + call test_batch_retries_on_503() + call test_health() + call test_health_degraded_does_not_fail() + call test_trailing_slash_is_not_duplicated() + call test_invalid_configuration_is_rejected() + call test_user_agent_identifies_the_library() + call test_status_names_exist() + + call server_stop(server) + deallocate (SE, PAULISTA, CITYWIDE, CSV_HEADER, HEALTH_BODY, base) + + write (output_unit, '(A)') '' + write (output_unit, '(A,I0,A,I0,A)') 'passed ', passed, ', failed ', failed, '' + if (failed > 0) stop 1 + +contains + + subroutine build_fixtures() + SE = '{"cep":"01001000","logradouro":"Pra\u00e7a da S\u00e9",' + SE = SE//'"complemento":"lado \u00edmpar","unidade":"","bairro":"S\u00e9",' + SE = SE//'"localidade":"S\u00e3o Paulo","uf":"SP","estado":"S\u00e3o Paulo",' + SE = SE//'"regiao":"Sudeste","ibge":"3550308","gia":"1004","ddd":"11",' + SE = SE//'"siafi":"7107"}' + + PAULISTA = '{"cep":"01310100","logradouro":"Avenida Paulista",' + PAULISTA = PAULISTA//'"complemento":"","unidade":"","bairro":"Bela Vista",' + PAULISTA = PAULISTA//'"localidade":"Sao Paulo","uf":"SP","estado":"Sao Paulo",' + PAULISTA = PAULISTA//'"regiao":"Sudeste","ibge":"3550308","gia":"1004",' + PAULISTA = PAULISTA//'"ddd":"11","siafi":"7107","geo":{"lat":-23.567202,' + PAULISTA = PAULISTA//'"lon":-46.649659,"raio_m":1084,"precisao":"logradouro"}}' + + CITYWIDE = '{"cep":"69900000","logradouro":"","complemento":"","unidade":"",' + CITYWIDE = CITYWIDE//'"bairro":"","localidade":"Rio Branco","uf":"AC",' + CITYWIDE = CITYWIDE//'"estado":"Acre","regiao":"Norte","ibge":"1200401",' + CITYWIDE = CITYWIDE//'"gia":"","ddd":"68","siafi":"0003","geo":{"lat":-9.9754,' + CITYWIDE = CITYWIDE//'"lon":-67.8249,"raio_m":21400,"precisao":"localidade"}}' + + CSV_HEADER = 'cep,logradouro,complemento,unidade,bairro,localidade,uf,' + CSV_HEADER = CSV_HEADER//'estado,regiao,ibge,gia,ddd,siafi' + + HEALTH_BODY = '{"status":"ok","dne":"26071","ceps":1596168,"geo":894489,' + HEALTH_BODY = HEALTH_BODY//'"base_gerada_em":"2026-07-24T03:48:28Z"}' + end subroutine build_fixtures + + subroutine check(condition, name) + logical, intent(in) :: condition + character(len=*), intent(in) :: name + + if (condition) then + passed = passed + 1 + else + failed = failed + 1 + write (output_unit, '(A)') 'FAIL '//name + end if + end subroutine check + + subroutine local_client(client, max_attempts, backoff_max, total_timeout, url) + type(cepis_client), intent(out) :: client + integer, intent(in), optional :: max_attempts + real(real64), intent(in), optional :: backoff_max + real(real64), intent(in), optional :: total_timeout + character(len=*), intent(in), optional :: url + integer :: status + character(len=:), allocatable :: message + + if (present(url)) then + call cepis_client_init(client, status, message, base_url=url, & + timeout=5.0_real64, backoff_base=0.001_real64, & + backoff_max=0.05_real64) + else + call cepis_client_init(client, status, message, base_url=base, & + timeout=5.0_real64, backoff_base=0.001_real64, & + backoff_max=0.05_real64) + end if + if (present(max_attempts)) client%max_attempts = max_attempts + if (present(backoff_max)) client%backoff_max = backoff_max + if (present(total_timeout)) client%total_timeout = total_timeout + end subroutine local_client + + function elapsed_since(start) result(seconds) + integer(int64), intent(in) :: start + real(real64) :: seconds + integer(int64) :: now, rate + + call system_clock(now, rate) + seconds = real(now - start, real64)/real(max(rate, 1_int64), real64) + end function elapsed_since + + function now_ticks() result(ticks) + integer(int64) :: ticks, rate + + call system_clock(ticks, rate) + end function now_ticks + + function occurrences(text, needle) result(total) + character(len=*), intent(in) :: text + character(len=*), intent(in) :: needle + integer :: total, at, from + + total = 0 + from = 1 + do + at = index(text(from:), needle) + if (at == 0) exit + total = total + 1 + from = from + at + len(needle) - 1 + if (from > len(text)) exit + end do + end function occurrences + + subroutine test_normalize_accepts_masked_and_unmasked() + character(len=:), allocatable :: digits, message + integer :: status + + call cepis_normalize_cep('01001-000', digits, status, message) + call check(status == CEPIS_OK .and. digits == '01001000', 'normalize masked') + + call cepis_normalize_cep('01001000', digits, status, message) + call check(status == CEPIS_OK .and. digits == '01001000', 'normalize unmasked') + + call cepis_normalize_cep(' 01001-000 ', digits, status, message) + call check(status == CEPIS_OK .and. digits == '01001000', 'normalize padded') + + call cepis_normalize_cep('01.001-000', digits, status, message) + call check(status == CEPIS_OK .and. digits == '01001000', 'normalize dotted') + end subroutine test_normalize_accepts_masked_and_unmasked + + subroutine test_normalize_rejects_bad_format() + character(len=:), allocatable :: digits, message + integer :: status + + call cepis_normalize_cep('1234567', digits, status, message) + call check(status == CEPIS_ERR_INVALID_CEP, 'normalize rejects 7 digits') + + call cepis_normalize_cep('123456789', digits, status, message) + call check(status == CEPIS_ERR_INVALID_CEP, 'normalize rejects 9 digits') + + call cepis_normalize_cep('0100100a', digits, status, message) + call check(status == CEPIS_ERR_INVALID_CEP, 'normalize rejects letters') + + call cepis_normalize_cep('', digits, status, message) + call check(status == CEPIS_ERR_INVALID_CEP, 'normalize rejects empty') + + call check(len(message) > 0, 'normalize explains the failure') + end subroutine test_normalize_rejects_bad_format + + subroutine test_format_cep() + call check(cepis_format_cep('01001000') == '01001-000', 'format_cep masks') + call check(cepis_format_cep('123') == '', 'format_cep rejects short input') + end subroutine test_format_cep + + subroutine test_json_reads_long_values_without_truncation() + type(json_document) :: doc + character(len=:), allocatable :: message, long, body + logical :: ok + integer :: i + + long = '' + do i = 1, 400 + long = long//'Rua Muito Comprida ' + end do + + body = '{"logradouro":"'//long//'","uf":"SP"}' + call json_parse(body, doc, ok, message) + call check(ok, 'json parses a long document') + call check(doc%field_text(doc%root, 'logradouro') == long, & + 'json keeps a 7600-character value intact') + call check(len(doc%field_text(doc%root, 'logradouro')) == len(long), & + 'json does not truncate a long value') + call check(doc%field_text(doc%root, 'uf') == 'SP', & + 'json reads the field after a long one') + end subroutine test_json_reads_long_values_without_truncation + + subroutine test_json_decodes_escapes_and_surrogates() + type(json_document) :: doc + character(len=:), allocatable :: message + character(len=:), allocatable :: expected + logical :: ok + + call json_parse(SE, doc, ok, message) + call check(ok, 'json parses the native contract') + + expected = 'Pra'//char(195)//char(167)//'a da S'//char(195)//char(169) + call check(doc%field_text(doc%root, 'logradouro') == expected, & + 'json decodes \u escapes to UTF-8') + + call json_parse('{"a":"x\ty\ny","b":"\ud83d\ude00","c":"\\","d":"\""}', & + doc, ok, message) + call check(ok, 'json parses every escape form') + call check(doc%field_text(doc%root, 'a') == 'x'//char(9)//'y'//char(10)//'y', & + 'json decodes control escapes') + call check(doc%field_text(doc%root, 'b') == & + char(240)//char(159)//char(152)//char(128), & + 'json decodes a surrogate pair') + call check(doc%field_text(doc%root, 'c') == char(92), 'json decodes a backslash') + call check(doc%field_text(doc%root, 'd') == '"', 'json decodes a quote') + end subroutine test_json_decodes_escapes_and_surrogates + + subroutine test_json_rejects_garbage() + type(json_document) :: doc + character(len=:), allocatable :: message + logical :: ok + + call json_parse('<html>nope</html>', doc, ok, message) + call check(.not. ok, 'json rejects HTML') + call check(len(message) > 0, 'json says why it rejected the body') + + call json_parse('{"a":1', doc, ok, message) + call check(.not. ok, 'json rejects a truncated object') + + call json_parse('{"a":1} trailing', doc, ok, message) + call check(.not. ok, 'json rejects trailing characters') + end subroutine test_json_rejects_garbage + + subroutine test_csv_reads_quoted_and_long_values() + type(csv_table) :: table + character(len=:), allocatable :: message, long, body + logical :: ok + integer :: i + + long = '' + do i = 1, 500 + long = long//'ABCDEFGHIJ' + end do + + body = 'cep,logradouro,uf'//char(10)// & + '01001000,"Rua Um, Dois",SP'//char(10)// & + '01001001,"He said ""hi""",RJ'//char(10)// & + '01001002,'//long//',MG'//char(10) + + call csv_parse(body, table, ok, message) + call check(ok, 'csv parses the document') + call check(table%height() == 4, 'csv finds every row') + call check(table%cell(2, 'logradouro') == 'Rua Um, Dois', & + 'csv keeps a comma inside a quoted field') + call check(table%cell(2, 'uf') == 'SP', 'csv does not shift after a quoted field') + call check(table%cell(3, 'logradouro') == 'He said "hi"', & + 'csv unescapes a doubled quote') + call check(table%cell(4, 'logradouro') == long, & + 'csv keeps a 5000-character value intact') + call check(table%cell(4, 'uf') == 'MG', 'csv reads the column after a long one') + call check(table%cell(2, 'missing') == '', 'csv returns empty for an absent column') + end subroutine test_csv_reads_quoted_and_long_values + + subroutine test_csv_reads_crlf_and_bom() + type(csv_table) :: table + character(len=:), allocatable :: message, body + logical :: ok + + body = char(239)//char(187)//char(191)//'cep,uf'//char(13)//char(10)// & + '01001000,SP'//char(13)//char(10) + call csv_parse(body, table, ok, message) + call check(ok, 'csv parses CRLF with a byte-order mark') + call check(table%column('cep') == 1, 'csv strips the byte-order mark') + call check(table%cell(2, 'uf') == 'SP', 'csv strips the carriage return') + + call csv_parse('cep,uf'//char(10)//'01001000,"unterminated', table, ok, message) + call check(.not. ok, 'csv rejects an unterminated quoted field') + end subroutine test_csv_reads_crlf_and_bom + + subroutine test_retry_after_parses_both_forms() + real(real64) :: seconds + logical :: ok + + call http_parse_retry_after(' 120 ', seconds, ok) + call check(ok .and. abs(seconds - 120.0_real64) < 1.0e-9_real64, & + 'Retry-After reads a number of seconds') + + call http_parse_retry_after('Wed, 21 Oct 2099 07:28:00 GMT', seconds, ok) + call check(ok .and. seconds > 1.0e9_real64, 'Retry-After reads an HTTP date') + + call http_parse_retry_after('Thu, 01 Jan 1970 00:00:00 GMT', seconds, ok) + call check(ok .and. seconds < 1.0e-9_real64, & + 'Retry-After in the past is not a negative wait') + + call http_parse_retry_after('not a date', seconds, ok) + call check(.not. ok, 'Retry-After ignores nonsense') + end subroutine test_retry_after_parses_both_forms + + subroutine test_successful_lookup() + type(cepis_client) :: client + type(cepis_address) :: address + character(len=:), allocatable :: message + integer :: status + + call server_reset(server) + call server_respond(server, '/01001000', 200, SE, '') + call local_client(client) + + call client%lookup('01001-000', address, status, message) + call check(status == CEPIS_OK, 'lookup succeeds') + call check(address%found, 'lookup marks the address found') + call check(address%cep == '01001000', 'lookup reads cep') + call check(address%uf == 'SP', 'lookup reads uf') + call check(address%ibge == '3550308', 'lookup reads ibge') + call check(address%unidade == '', 'an absent field is the empty string') + call check(address%formatted_cep() == '01001-000', 'formatted_cep masks') + call check(.not. address%has_geo, 'no geo block means has_geo is false') + call check(len(address%raw) > 0, 'lookup keeps the raw body') + call check(server_path(server, 1) == '/01001000', 'lookup asks for the right path') + end subroutine test_successful_lookup + + subroutine test_reads_the_coordinate_when_present() + type(cepis_client) :: client + type(cepis_address) :: address + character(len=:), allocatable :: message + integer :: status + + call server_reset(server) + call server_respond(server, '/01310100', 200, PAULISTA, '') + call local_client(client) + + call client%lookup('01310100', address, status, message) + call check(status == CEPIS_OK, 'lookup with geo succeeds') + call check(address%has_geo, 'has_geo is true when the block is present') + call check(abs(address%geo%lat + 23.567202_real64) < 1.0e-6_real64, 'geo lat') + call check(abs(address%geo%lon + 46.649659_real64) < 1.0e-6_real64, 'geo lon') + call check(address%geo%raio_m == 1084, 'geo raio_m') + call check(address%geo%precisao == 'logradouro', 'geo precisao') + call check(address%geo%is_precise(), 'a street coordinate is precise') + end subroutine test_reads_the_coordinate_when_present + + subroutine test_municipality_coordinate_is_not_precise() + type(cepis_client) :: client + type(cepis_address) :: address + character(len=:), allocatable :: message + integer :: status + + call server_reset(server) + call server_respond(server, '/69900000', 200, CITYWIDE, '') + call local_client(client) + + call client%lookup('69900000', address, status, message) + call check(status == CEPIS_OK, 'city-wide lookup succeeds') + call check(address%has_geo, 'city-wide CEP carries a coordinate') + call check(.not. address%geo%is_precise(), & + 'a municipality centroid is not precise') + call check(address%geo%raio_m == 21400, 'city-wide raio_m is kilometres wide') + end subroutine test_municipality_coordinate_is_not_precise + + subroutine test_malformed_geo_does_not_lose_the_address() + type(cepis_client) :: client + type(cepis_address) :: address + character(len=:), allocatable :: message + integer :: status + + call server_reset(server) + call server_respond(server, '/01001000', 200, & + '{"cep":"01001000","localidade":"Sao Paulo","uf":"SP",'// & + '"geo":{"lat":"nope","lon":null}}', '') + call local_client(client) + + call client%lookup('01001000', address, status, message) + call check(status == CEPIS_OK, 'a malformed geo is not a failure') + call check(.not. address%has_geo, 'a malformed geo is dropped') + call check(address%localidade == 'Sao Paulo', 'the address survives') + end subroutine test_malformed_geo_does_not_lose_the_address + + subroutine test_new_api_field_does_not_break() + type(cepis_client) :: client + type(cepis_address) :: address + character(len=:), allocatable :: message + integer :: status + + call server_reset(server) + call server_respond(server, '/01001000', 200, & + '{"cep":"01001000","uf":"SP","novidade":{"a":[1,2,3]},'// & + '"outra":true}', '') + call local_client(client) + + call client%lookup('01001000', address, status, message) + call check(status == CEPIS_OK, 'an unknown field does not break the client') + call check(address%uf == 'SP', 'the known fields still arrive') + call check(index(address%raw, 'novidade') > 0, 'the unknown field survives in raw') + end subroutine test_new_api_field_does_not_break + + subroutine test_not_found_is_not_retried() + type(cepis_client) :: client + type(cepis_address) :: address + character(len=:), allocatable :: message + integer :: status + + call server_reset(server) + call server_respond(server, '/99999999', 404, & + '{"erro":"cep_nao_encontrado",'// & + '"mensagem":"CEP nao existe na base do DNE"}', '') + call local_client(client) + + call client%lookup('99999999', address, status, message) + call check(status == CEPIS_ERR_NOT_FOUND, '404 becomes not found') + call check(server_count(server, '/99999999') == 1, '404 is not retried') + call check(len(message) > 0, 'not found explains itself') + end subroutine test_not_found_is_not_retried + + subroutine test_invalid_cep_never_leaves_the_machine() + type(cepis_client) :: client + type(cepis_address) :: address + character(len=:), allocatable :: message + integer :: status + + call server_reset(server) + call local_client(client) + + call client%lookup('123', address, status, message) + call check(status == CEPIS_ERR_INVALID_CEP, 'a short CEP is rejected locally') + call check(server_total(server) == 0, 'no request is made for a bad CEP') + end subroutine test_invalid_cep_never_leaves_the_machine + + subroutine test_api_400_becomes_invalid_cep() + type(cepis_client) :: client + type(cepis_address) :: address + character(len=:), allocatable :: message + integer :: status + + call server_reset(server) + call server_respond(server, '/00000000', 400, & + '{"erro":"cep_invalido","mensagem":"CEP deve ter 8 digitos"}', '') + call local_client(client) + + call client%lookup('00000000', address, status, message) + call check(status == CEPIS_ERR_INVALID_CEP, '400 becomes invalid CEP') + call check(message == 'CEP deve ter 8 digitos', 'the API message is carried through') + call check(server_count(server, '/00000000') == 1, '400 is not retried') + end subroutine test_api_400_becomes_invalid_cep + + subroutine test_response_that_is_not_json() + type(cepis_client) :: client + type(cepis_address) :: address + character(len=:), allocatable :: message + integer :: status + + call server_reset(server) + call server_respond(server, '/01001000', 200, & + '<html><body>captive portal</body></html>', '') + call local_client(client) + + call client%lookup('01001000', address, status, message) + call check(status == CEPIS_ERR_INVALID_RESPONSE, 'HTML is an invalid response') + call check(index(message, 'captive') > 0, 'the body is quoted back for diagnosis') + end subroutine test_response_that_is_not_json + + subroutine test_retries_on_500_then_succeeds() + type(cepis_client) :: client + type(cepis_address) :: address + character(len=:), allocatable :: message + integer :: status + + call server_reset(server) + call server_respond(server, '/01001000', 500, '{"erro":"interno"}', '') + call server_respond_more(server, '/01001000', 200, SE, '') + call local_client(client) + + call client%lookup('01001000', address, status, message) + call check(status == CEPIS_OK, 'a transient 500 is retried') + call check(address%uf == 'SP', 'the retry returns the address') + call check(server_count(server, '/01001000') == 2, 'exactly two attempts were made') + end subroutine test_retries_on_500_then_succeeds + + subroutine test_exhausts_attempts_then_fails() + type(cepis_client) :: client + type(cepis_address) :: address + character(len=:), allocatable :: message + integer :: status, http_status + + call server_reset(server) + call server_respond(server, '/01001000', 502, 'bad gateway', '') + call local_client(client, max_attempts=3) + + call client%lookup('01001000', address, status, message, http_status=http_status) + call check(status == CEPIS_ERR_SERVER, 'exhausted attempts give a server error') + call check(http_status == 502, 'the last HTTP status is exposed') + call check(server_count(server, '/01001000') == 3, 'every attempt was made') + end subroutine test_exhausts_attempts_then_fails + + subroutine test_max_attempts_one_disables_retry() + type(cepis_client) :: client + type(cepis_address) :: address + character(len=:), allocatable :: message + integer :: status + + call server_reset(server) + call server_respond(server, '/01001000', 503, 'unavailable', '') + call local_client(client, max_attempts=1) + + call client%lookup('01001000', address, status, message) + call check(status == CEPIS_ERR_SERVER, 'a single attempt still reports the error') + call check(server_count(server, '/01001000') == 1, 'max_attempts=1 makes one request') + end subroutine test_max_attempts_one_disables_retry + + subroutine test_429_becomes_rate_limited_with_retry_after() + type(cepis_client) :: client + type(cepis_address) :: address + character(len=:), allocatable :: message + integer :: status + real(real64) :: retry_after + + call server_reset(server) + call server_respond(server, '/01001000', 429, 'slow down', 'Retry-After: 2') + call local_client(client, max_attempts=2, backoff_max=0.05_real64) + + call client%lookup('01001000', address, status, message, retry_after=retry_after) + call check(status == CEPIS_ERR_RATE_LIMITED, '429 becomes rate limited') + call check(abs(retry_after - 2.0_real64) < 1.0e-9_real64, & + 'Retry-After is exposed to the caller') + call check(server_count(server, '/01001000') == 2, '429 is retried') + end subroutine test_429_becomes_rate_limited_with_retry_after + + subroutine test_retry_after_http_date_is_understood() + type(cepis_client) :: client + type(cepis_address) :: address + character(len=:), allocatable :: message + integer :: status + real(real64) :: retry_after + + call server_reset(server) + call server_respond(server, '/01001000', 429, 'slow down', & + 'Retry-After: Wed, 21 Oct 2099 07:28:00 GMT') + call local_client(client, max_attempts=2, backoff_max=0.05_real64) + + call client%lookup('01001000', address, status, message, retry_after=retry_after) + call check(status == CEPIS_ERR_RATE_LIMITED, 'a dated 429 is still rate limited') + call check(retry_after > 1.0e9_real64, 'an HTTP-date Retry-After is understood') + end subroutine test_retry_after_http_date_is_understood + + subroutine test_retry_after_honours_the_cap() + type(cepis_client) :: client + type(cepis_address) :: address + character(len=:), allocatable :: message + integer :: status + integer(int64) :: start + + call server_reset(server) + call server_respond(server, '/01001000', 429, 'slow down', 'Retry-After: 3600') + call local_client(client, max_attempts=2, backoff_max=0.05_real64) + + start = now_ticks() + call client%lookup('01001000', address, status, message) + call check(status == CEPIS_ERR_RATE_LIMITED, 'a huge Retry-After still fails cleanly') + call check(elapsed_since(start) < 10.0_real64, & + 'Retry-After is capped at backoff_max') + end subroutine test_retry_after_honours_the_cap + + subroutine test_network_error_when_nothing_listens() + type(cepis_client) :: client + type(cepis_address) :: address + character(len=:), allocatable :: message + integer :: status + + call local_client(client, max_attempts=2, backoff_max=0.01_real64, & + url='http://127.0.0.1:1') + + call client%lookup('01001000', address, status, message) + call check(status == CEPIS_ERR_NETWORK, 'a refused connection is a network error') + call check(len(message) > 0, 'the network error carries libcurl detail') + end subroutine test_network_error_when_nothing_listens + + subroutine test_total_timeout_bounds_the_whole_call() + type(cepis_client) :: client + type(cepis_address) :: address + character(len=:), allocatable :: message + integer :: status + integer(int64) :: start + + call server_reset(server) + call server_respond(server, '/01001000', 500, 'boom', '') + call local_client(client, max_attempts=8, total_timeout=0.4_real64) + client%backoff_base = 1.0_real64 + client%backoff_max = 8.0_real64 + + start = now_ticks() + call client%lookup('01001000', address, status, message) + call check(status == CEPIS_ERR_SERVER, 'the bounded call still reports the error') + call check(elapsed_since(start) < 8.0_real64, 'total_timeout bounds the whole call') + end subroutine test_total_timeout_bounds_the_whole_call + + subroutine test_batch_preserves_order_and_marks_missing() + type(cepis_client) :: client + type(cepis_address), allocatable :: addresses(:) + character(len=:), allocatable :: message + integer :: status + + call server_reset(server) + call server_respond_default(server, 200, CSV_HEADER//char(10)// & + '01001000,Praca da Se,lado impar,,Se,Sao Paulo,SP,'// & + 'Sao Paulo,Sudeste,3550308,1004,11,7107'//char(10)// & + '99999999,,,,,,,,,,,,'//char(10)// & + '20040020,Avenida Rio Branco,,,Centro,Rio de Janeiro,'// & + 'RJ,Rio de Janeiro,Sudeste,3304557,,21,6001'//char(10), '') + call local_client(client) + + call client%lookup_many(['01001000', '99999999', '20040020'], addresses, & + status, message) + call check(status == CEPIS_OK, 'the batch succeeds') + call check(size(addresses) == 3, 'the batch keeps its length') + call check(addresses(1)%found, 'the first CEP resolved') + call check(.not. addresses(2)%found, 'the missing CEP is marked not found') + call check(addresses(2)%cep == '99999999', & + 'the missing CEP keeps its place and its number') + call check(addresses(3)%found, 'the third CEP resolved') + call check(addresses(3)%localidade == 'Rio de Janeiro', & + 'the third CEP is not shifted by the missing one') + call check(.not. addresses(1)%has_geo, 'the batch carries no coordinate') + call check(server_count(server, '/csv') == 1, 'the batch is one request') + end subroutine test_batch_preserves_order_and_marks_missing + + subroutine test_batch_field_with_comma_is_parsed() + type(cepis_client) :: client + type(cepis_address), allocatable :: addresses(:) + character(len=:), allocatable :: message + integer :: status + + call server_reset(server) + call server_respond_default(server, 200, CSV_HEADER//char(10)// & + '01001000,"Rua Um, Dois","de 1 a 99",,Centro,'// & + 'Sao Paulo,SP,Sao Paulo,Sudeste,3550308,1004,11,7107'// & + char(10), '') + call local_client(client) + + call client%lookup_many(['01001000'], addresses, status, message) + call check(status == CEPIS_OK, 'the quoted batch succeeds') + call check(addresses(1)%logradouro == 'Rua Um, Dois', & + 'a comma inside a field is not a separator') + call check(addresses(1)%uf == 'SP', 'the columns after it are still aligned') + end subroutine test_batch_field_with_comma_is_parsed + + subroutine test_batch_empty_list_makes_no_request() + type(cepis_client) :: client + type(cepis_address), allocatable :: addresses(:) + character(len=8), allocatable :: nothing(:) + character(len=:), allocatable :: message + integer :: status + + call server_reset(server) + call local_client(client) + allocate (nothing(0)) + + call client%lookup_many(nothing, addresses, status, message) + call check(status == CEPIS_OK, 'an empty batch succeeds') + call check(size(addresses) == 0, 'an empty batch returns nothing') + call check(server_total(server) == 0, 'an empty batch makes no request') + end subroutine test_batch_empty_list_makes_no_request + + subroutine test_batch_chunks_above_the_api_limit() + type(cepis_client) :: client + type(cepis_address), allocatable :: addresses(:) + character(len=8) :: many(501) + character(len=:), allocatable :: message + character(len=8) :: scratch + integer :: status, i + + call server_reset(server) + call server_respond_default(server, 200, CSV_HEADER//char(10), '') + call local_client(client) + + do i = 1, 501 + write (scratch, '(I8.8)') i + many(i) = scratch + end do + + call client%lookup_many(many, addresses, status, message) + call check(status == CEPIS_OK, 'a batch above the limit succeeds') + call check(size(addresses) == 501, 'the oversized batch keeps its length') + call check(server_count(server, '/csv') == 2, 'the batch is chunked at 500') + call check(occurrences(server_path(server, 1), '%2C') == 499, & + 'the first chunk carries 500 CEPs') + call check(occurrences(server_path(server, 2), '%2C') == 0, & + 'the second chunk carries the remaining one') + end subroutine test_batch_chunks_above_the_api_limit + + subroutine test_batch_truncated_response_does_not_shift() + type(cepis_client) :: client + type(cepis_address), allocatable :: addresses(:) + character(len=:), allocatable :: message + integer :: status + + call server_reset(server) + call server_respond_default(server, 200, CSV_HEADER//char(10)// & + '01001000,Praca da Se,,,Se,Sao Paulo,SP,Sao Paulo,'// & + 'Sudeste,3550308,1004,11,7107'//char(10), '') + call local_client(client) + + call client%lookup_many(['01001000', '20040020', '30140071'], addresses, & + status, message) + call check(status == CEPIS_OK, 'a short response is not an error') + call check(size(addresses) == 3, 'a short response is padded, not returned short') + call check(addresses(1)%found, 'the row that arrived is used') + call check(.not. addresses(2)%found, 'the missing rows are not found') + call check(.not. addresses(3)%found, 'the last missing row is not found') + call check(addresses(3)%cep == '30140071', 'the padded entries keep their CEP') + end subroutine test_batch_truncated_response_does_not_shift + + subroutine test_batch_malformed_cep_is_not_found() + type(cepis_client) :: client + type(cepis_address), allocatable :: addresses(:) + character(len=:), allocatable :: message + integer :: status + + call server_reset(server) + call server_respond_default(server, 200, CSV_HEADER//char(10)// & + 'abc,,,,,,,,,,,,'//char(10)// & + '01001000,Praca da Se,,,Se,Sao Paulo,SP,Sao Paulo,'// & + 'Sudeste,3550308,1004,11,7107'//char(10), '') + call local_client(client) + + call client%lookup_many(['abc ', '01001000'], addresses, status, message) + call check(status == CEPIS_OK, 'a malformed CEP does not fail the batch') + call check(.not. addresses(1)%found, 'a malformed CEP is simply not found') + call check(addresses(2)%found, 'the rest of the batch still resolves') + end subroutine test_batch_malformed_cep_is_not_found + + subroutine test_batch_retries_on_503() + type(cepis_client) :: client + type(cepis_address), allocatable :: addresses(:) + character(len=:), allocatable :: message + integer :: status + + call server_reset(server) + call server_respond_default(server, 503, 'unavailable', '') + call local_client(client, max_attempts=2) + + call client%lookup_many(['01001000'], addresses, status, message) + call check(status == CEPIS_ERR_SERVER, 'a batch 503 is a server error') + call check(server_count(server, '/csv') == 2, 'the batch retries on 503') + end subroutine test_batch_retries_on_503 + + subroutine test_health() + type(cepis_client) :: client + type(cepis_health) :: health + character(len=:), allocatable :: message + integer :: status + + call server_reset(server) + call server_respond(server, '/health', 200, HEALTH_BODY, '') + call local_client(client) + + call client%health(health, status, message) + call check(status == CEPIS_OK, 'health succeeds') + call check(health%ok(), 'health reports ok') + call check(health%dne == '26071', 'health carries the database identifier') + call check(health%ceps == 1596168_int64, 'health counts the CEPs') + call check(health%geo == 894489_int64, 'health counts the coordinates') + call check(health%base_gerada_em == '2026-07-24T03:48:28Z', 'health dates the base') + end subroutine test_health + + subroutine test_health_degraded_does_not_fail() + type(cepis_client) :: client + type(cepis_health) :: health + character(len=:), allocatable :: message + integer :: status + + call server_reset(server) + call server_respond(server, '/health', 503, & + '{"status":"degraded","dne":"26071","ceps":0,"geo":0,'// & + '"base_gerada_em":""}', '') + call local_client(client, max_attempts=3) + + call client%health(health, status, message) + call check(status == CEPIS_OK, 'a degraded API is not an error') + call check(.not. health%ok(), 'the degradation arrives in status') + call check(health%status == 'degraded', 'the reported status is carried through') + call check(server_count(server, '/health') == 1, 'a 503 from health is not retried') + end subroutine test_health_degraded_does_not_fail + + subroutine test_trailing_slash_is_not_duplicated() + type(cepis_client) :: client + type(cepis_address) :: address + character(len=:), allocatable :: message + integer :: status + + call server_reset(server) + call server_respond(server, '/01001000', 200, SE, '') + call local_client(client, url=base//'///') + + call client%lookup('01001000', address, status, message) + call check(status == CEPIS_OK, 'a trailing slash in base_url still works') + call check(server_path(server, 1) == '/01001000', 'the path has no doubled separator') + end subroutine test_trailing_slash_is_not_duplicated + + subroutine test_invalid_configuration_is_rejected() + type(cepis_client) :: client + character(len=:), allocatable :: message + integer :: status + + call cepis_client_init(client, status, message, max_attempts=0) + call check(status == CEPIS_ERR_CONFIG, 'max_attempts below one is rejected') + + call cepis_client_init(client, status, message, timeout=0.0_real64) + call check(status == CEPIS_ERR_CONFIG, 'a zero timeout is rejected') + + call cepis_client_init(client, status, message, base_url=' ') + call check(status == CEPIS_ERR_CONFIG, 'an empty base_url is rejected') + + call cepis_client_init(client, status, message) + call check(status == CEPIS_OK, 'the defaults are valid') + call check(client%url() == CEPIS_DEFAULT_BASE_URL, 'the default base_url is cep.is') + end subroutine test_invalid_configuration_is_rejected + + subroutine test_user_agent_identifies_the_library() + type(cepis_client) :: client + character(len=:), allocatable :: message + integer :: status + + call cepis_client_init(client, status, message) + call check(index(client%agent(), 'cepis-fortran/') > 0, & + 'the user agent names the library') + call check(index(client%agent(), CEPIS_VERSION) > 0, & + 'the user agent carries the version') + end subroutine test_user_agent_identifies_the_library + + subroutine test_status_names_exist() + call check(cepis_status_name(CEPIS_OK) == 'ok', 'ok has a name') + call check(cepis_status_name(CEPIS_ERR_NOT_FOUND) == 'not_found', & + 'not found has a name') + call check(cepis_status_name(CEPIS_ERR_INVALID_RESPONSE) == 'invalid_response', & + 'invalid response has a name') + call check(cepis_status_name(-1) == 'unknown', 'an unknown code has a name') + end subroutine test_status_names_exist + +end program test_cepis |