!> 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('nope', 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, & 'captive portal', '') 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