From 3741d3042b930d92239bbca206842c8730dc4dff Mon Sep 17 00:00:00 2001 From: Philipp Date: Wed, 21 Feb 2024 18:38:26 +0100 Subject: [PATCH] Refactoring. Minor updates. --- share/dmpack.js | 5 ++--- src/dm_geocom_api.f90 | 2 +- src/dm_html.f90 | 3 ++- src/dm_mqtt.f90 | 15 ++++++++------- src/dm_mqueue.f90 | 15 +++++++-------- src/dm_nml.f90 | 10 +++++----- src/dm_test.f90 | 23 ++++++++++++++++++++++- test/dmtestlogger.f90 | 22 ++-------------------- test/dmtestmail.f90 | 5 ++--- test/dmtestmqtt.f90 | 5 ++--- test/dmtestmqueue.f90 | 24 ++++-------------------- test/dmtestpipe.f90 | 22 ++-------------------- test/dmtestplot.f90 | 24 +++--------------------- test/dmtestrpc.f90 | 5 ++--- 14 files changed, 64 insertions(+), 116 deletions(-) diff --git a/share/dmpack.js b/share/dmpack.js index 5d456b7..433023e 100644 --- a/share/dmpack.js +++ b/share/dmpack.js @@ -1,6 +1,4 @@ -/* - * Additional formatting of ISO 8601 time stamps in the DMPACK web interface. - */ +/* Additional formatting of ISO 8601 time stamps in the DMPACK web interface. */ function formatTimeElements() { var times = document.getElementsByTagName('time'); @@ -8,6 +6,7 @@ function formatTimeElements() for (var i = 0; i < times.length; i++) { var attr = times[i].getAttribute('datetime'); + if (attr.length != 25) continue; var date = attr.substring(0, 10); var time = attr.substring(11, 19); var zone = attr.substring(19); diff --git a/src/dm_geocom_api.f90 b/src/dm_geocom_api.f90 index ce15469..f67f678 100644 --- a/src/dm_geocom_api.f90 +++ b/src/dm_geocom_api.f90 @@ -455,7 +455,7 @@ pure subroutine dm_geocom_api_request(request, code, arguments, pattern, respons end subroutine dm_geocom_api_request ! ************************************************************************** - ! GEOCOM REQUEST PREPARATION PROCEDURES. + ! PUBLIC GEOCOM REQUEST PREPARATION PROCEDURES. ! ************************************************************************** pure subroutine dm_geocom_api_request_abort_download(request) !! Request of `FTR_AbortDownload` procedure. Creates request to abort diff --git a/src/dm_html.f90 b/src/dm_html.f90 index 9097fc5..c2c54ac 100644 --- a/src/dm_html.f90 +++ b/src/dm_html.f90 @@ -586,7 +586,8 @@ function dm_html_header(title, subtitle, style, internal_style, brand, nav, mask !! style sheet file and internal CSS can be added. !! !! The first heading will be set to the page title. The heading is - !! shown only if no navigation array is passed. + !! shown only if no navigation array is passed. The brand title `brand` + !! will be placed in a level 3 heading. !! !! The given title and sub-title are encoded by this function. character(len=*), intent(in) :: title !! HTML page title and first heading. diff --git a/src/dm_mqtt.f90 b/src/dm_mqtt.f90 index 9bdd084..aae69ed 100644 --- a/src/dm_mqtt.f90 +++ b/src/dm_mqtt.f90 @@ -1,7 +1,8 @@ ! Author: Philipp Engel ! Licence: ISC module dm_mqtt - !! Module for publishing messages via MQTT, using libcurl. + !! Module for publishing messages via MQTT, using libcurl. The libcurl + !! library must have been built with the MQTT option enabled. !! !! Limitations of libcurl: !! @@ -29,8 +30,8 @@ module dm_mqtt !! # mosquitto_sub -h 127.0.0.1 -t /fortran !! ``` !! - !! In Fortran, we can then create the URL of the topic, and publish a - !! message to it: + !! In Fortran, we then create the URL of the topic `/fortran` on host + !! `127.0.0.1`, and publish the message: !! !! ```fortran !! character(len=:), allocatable :: url @@ -42,8 +43,7 @@ module dm_mqtt !! call dm_mqtt_destroy() !! ``` !! - !! Any client that has subscribed topic `/fortran` will receive the - !! message. + !! Any client subscribing topic `/fortran` will receive the message. !! !! The procedures `dm_mqtt_init()` and `dm_mqtt_destroy()` have to be called !! once per process, and only if neither the RPC nor the mail backend is @@ -69,7 +69,8 @@ integer function dm_mqtt_init() result(rc) end function dm_mqtt_init integer function dm_mqtt_publish(url, message, timeout, error_message, error_curl) result(rc) - !! Sends HTTP request by calling libcurl. + !! Publishes MQTT message `message` on topic with address `url` by + !! calling libcurl. character(len=*), intent(in) :: url !! URL to MQTT server/topic. character(len=*), target, intent(in) :: message !! Message to publish. integer, intent(in), optional :: timeout !! Connection timeout. @@ -140,7 +141,7 @@ end function dm_mqtt_publish function dm_mqtt_url(host, topic, port) result(url) !! Returns allocatable string of URL to MQTT server. Uses the URL API !! of libcurl to create the URL. If `port` is `0`, the default port - !! will be used. The topic must start with a `/`. + !! will be used. The topic must start with a `/` character. !! !! On error, an empty string is returned. character(len=*), intent(in) :: host !! IP or FQDN of MQTT server. diff --git a/src/dm_mqueue.f90 b/src/dm_mqueue.f90 index df604a8..1c2eaa4 100644 --- a/src/dm_mqueue.f90 +++ b/src/dm_mqueue.f90 @@ -3,7 +3,6 @@ module dm_mqueue !! Module for inter-process communication (IPC) and message passing through !! POSIX message queues. Has to be linked with `-lrt`. - use, intrinsic :: iso_c_binding use :: unix use :: dm_error use :: dm_id @@ -49,7 +48,7 @@ module dm_mqueue procedure :: mqueue_write_raw end interface - public :: dm_mqueue_attr + public :: dm_mqueue_attributes public :: dm_mqueue_close public :: dm_mqueue_open public :: dm_mqueue_read @@ -70,7 +69,7 @@ module dm_mqueue ! ****************************************************************** ! PUBLIC PROCEDURES. ! ****************************************************************** - integer function dm_mqueue_attr(mqueue, flags, max_msg, msg_size, cur_msgs) result(rc) + integer function dm_mqueue_attributes(mqueue, flags, max_msg, msg_size, cur_msgs) result(rc) !! Returns message queue attributes. type(mqueue_type), intent(inout) :: mqueue !! Message queue type. integer(kind=i8), intent(out), optional :: flags !! Flags. @@ -86,13 +85,13 @@ integer function dm_mqueue_attr(mqueue, flags, max_msg, msg_size, cur_msgs) resu rc = E_MQUEUE if (c_mq_getattr(mqueue%mqd, attr) < 0) return - if (present(flags)) flags = int(attr%mq_flags, kind=c_long) - if (present(max_msg)) max_msg = int(attr%mq_maxmsg, kind=c_long) - if (present(msg_size)) msg_size = int(attr%mq_msgsize, kind=c_long) - if (present(cur_msgs)) cur_msgs = int(attr%mq_curmsgs, kind=c_long) + if (present(flags)) flags = int(attr%mq_flags, kind=i8) + if (present(max_msg)) max_msg = int(attr%mq_maxmsg, kind=i8) + if (present(msg_size)) msg_size = int(attr%mq_msgsize, kind=i8) + if (present(cur_msgs)) cur_msgs = int(attr%mq_curmsgs, kind=i8) rc = E_NONE - end function dm_mqueue_attr + end function dm_mqueue_attributes integer function dm_mqueue_close(mqueue) result(rc) !! Closes message queue. diff --git a/src/dm_nml.f90 b/src/dm_nml.f90 index eb09430..c206390 100644 --- a/src/dm_nml.f90 +++ b/src/dm_nml.f90 @@ -1,7 +1,7 @@ ! Author: Philipp Engel ! Licence: ISC module dm_nml - !! Fortran namelist import/export of DMPACK derived types. + !! Fortran 95 Namelist import/export of DMPACK derived types. use :: dm_error use :: dm_file use :: dm_kind @@ -19,7 +19,7 @@ module dm_nml integer, parameter, public :: NML_TARGET_LEN = 296 !! Max. size of `target_type` namelist in bytes. interface dm_nml_from - !! Converts type to static or allocatable string. + !! Converts type to static or allocatable namelist string. module procedure :: nml_from_beat module procedure :: nml_from_log module procedure :: nml_from_node @@ -36,7 +36,7 @@ module dm_nml end interface interface dm_nml_to - !! Converts string to type. + !! Converts namelist string to type. module procedure :: nml_to_beat module procedure :: nml_to_log module procedure :: nml_to_node @@ -46,13 +46,13 @@ module dm_nml end interface interface dm_nml_read - !! Reads type from file or standard input. + !! Reads namelist from file or standard input. module procedure :: nml_read_log module procedure :: nml_read_observ end interface interface dm_nml_write - !! Writes type to file or standard output. + !! Writes namelist to file or standard output. module procedure :: nml_write_log module procedure :: nml_write_observ end interface diff --git a/src/dm_test.f90 b/src/dm_test.f90 index ffa7dc7..3a59195 100644 --- a/src/dm_test.f90 +++ b/src/dm_test.f90 @@ -62,10 +62,31 @@ end function dm_test_function public :: dm_test_dummy_target public :: dm_test_function public :: dm_test_run + public :: dm_test_skip contains ! ****************************************************************** ! PUBLIC PROCEDURES. ! ****************************************************************** + logical function dm_test_skip(env_var) result(skip) + !! Returns `.true.` and outputs a debug message if environment variable + !! of name `env_var` is set to 1. + use :: dm_env, only: dm_env_get, dm_env_has + character(len=*), intent(in) :: env_var !! Name of the environment variable. + + integer :: rc + logical :: no_color + + rc = dm_env_get(env_var, skip, .false.) + no_color = dm_env_has('NO_COLOR') + + if (skip) then + call dm_ansi_color(COLOR_YELLOW, no_color) + print '("> Environment variable ", a, " is set.")', trim(env_var) + print '("> This test will be skipped.")' + call dm_ansi_reset(no_color) + end if + end function dm_test_skip + impure elemental subroutine dm_test_dummy_beat(beat) !! Generates dummy beat data type. use :: dm_beat @@ -297,7 +318,7 @@ subroutine dm_test_run(tests, stats, no_color) call test_title('TEST SESSION STARTS', TEST_LINE_LEN) call dm_ansi_reset(no_color_) - print '("Time....: ", a)', dm_time_now() + print '("Time....: ", a)', dm_time_strip_useconds(dm_time_now()) print '("System..: ", a, 1x, a, " (", a, ")")', & trim(uname%system_name), trim(uname%release), trim(uname%machine) print '("Compiler: ", a)', compiler_version() diff --git a/test/dmtestlogger.f90 b/test/dmtestlogger.f90 index a0ac620..67cfb2d 100644 --- a/test/dmtestlogger.f90 +++ b/test/dmtestlogger.f90 @@ -8,31 +8,13 @@ program dmtestlogger implicit none (type, external) integer, parameter :: NTESTS = 1 - logical :: no_color logical :: stats(NTESTS) type(test_type) :: tests(NTESTS) call dm_init() - no_color = dm_env_has('NO_COLOR') - tests(1) = test_type('dmtestlogger.test01', test01) - - call dm_test_run(tests, stats, no_color) + call dm_test_run(tests, stats, dm_env_has('NO_COLOR')) contains - logical function skip_test() result(skip) - integer :: rc - - rc = dm_env_get('DM_MQUEUE_SKIP', skip) - - if (skip) then - call dm_ansi_color(COLOR_YELLOW, no_color) - print '("dmtestlogger:")' - print '(" Environment variable DM_MQUEUE_SKIP is set.")' - print '(" This test will be skipped.")' - call dm_ansi_reset(no_color) - end if - end function skip_test - logical function test01() result(stat) character(len=*), parameter :: JSON = & '{ "id": "f5ec2dd3870a47b5be3ae397552706fe", "level": 4, "error": 1, "timestamp": ' // & @@ -48,7 +30,7 @@ logical function test01() result(stat) type(observ_type) :: observ stat = TEST_PASSED - if (skip_test()) return + if (dm_test_skip('DM_MQUEUE_SKIP')) return stat = TEST_FAILED observ%id = '6b0ca75ae594425a8d38adfd709b11cd' diff --git a/test/dmtestmail.f90 b/test/dmtestmail.f90 index 80ef365..1c867c2 100644 --- a/test/dmtestmail.f90 +++ b/test/dmtestmail.f90 @@ -47,9 +47,8 @@ logical function get_env(from, to, host, username, password) result(has) dm_is_error(dm_env_get('DM_MAIL_PASSWORD', password))) then call dm_ansi_color(COLOR_YELLOW, no_color) - print '("dmtestmail:")' - print '(" Set environment variables DM_MAIL_FROM, DM_MAIL_TO, DM_MAIL_HOST,")' - print '(" DM_MAIL_USERNAME, and DM_MAIL_PASSWORD. This test will be skipped.")' + print '("> Set environment variables DM_MAIL_FROM, DM_MAIL_TO, DM_MAIL_HOST,")' + print '("> DM_MAIL_USERNAME, and DM_MAIL_PASSWORD. This test will be skipped.")' call dm_ansi_reset(no_color) return end if diff --git a/test/dmtestmqtt.f90 b/test/dmtestmqtt.f90 index 7ab43fd..c98a47b 100644 --- a/test/dmtestmqtt.f90 +++ b/test/dmtestmqtt.f90 @@ -38,9 +38,8 @@ logical function get_env(host, port) result(has) if (dm_is_error(dm_env_get('DM_MQTT_HOST', host)) .or. & dm_is_error(dm_env_get('DM_MQTT_PORT', port))) then call dm_ansi_color(COLOR_YELLOW, no_color) - print '("dmtestmqtt:")' - print '(" Set environment variables DM_MQTT_HOST and DM_MQTT_PORT.")' - print '(" This test will be skipped.")' + print '("> Set environment variables DM_MQTT_HOST and DM_MQTT_PORT.")' + print '("> This test will be skipped.")' call dm_ansi_reset(no_color) return end if diff --git a/test/dmtestmqueue.f90 b/test/dmtestmqueue.f90 index e92d693..555174a 100644 --- a/test/dmtestmqueue.f90 +++ b/test/dmtestmqueue.f90 @@ -25,32 +25,16 @@ program dmtestmqueue integer, parameter :: NTESTS = 2 - logical :: no_color logical :: stats(NTESTS) type(test_type) :: tests(NTESTS) call dm_init() - no_color = dm_env_has('NO_COLOR') tests(1) = test_type('dmtestmqueue.test01', test01) tests(2) = test_type('dmtestmqueue.test02', test02) - call dm_test_run(tests, stats, no_color) + call dm_test_run(tests, stats, dm_env_has('NO_COLOR')) contains - logical function skip_test() result(skip) - integer :: rc - - rc = dm_env_get('DM_MQUEUE_SKIP', skip, .false.) - - if (skip) then - call dm_ansi_color(COLOR_YELLOW, no_color) - print '("dmtestmqueue:")' - print '(" Environment variable DM_MQUEUE_SKIP is set.")' - print '(" This test will be skipped.")' - call dm_ansi_reset(no_color) - end if - end function skip_test - logical function test01() result(stat) !! Tests observation exchange using a single message queue descriptor. integer :: rc @@ -59,7 +43,7 @@ logical function test01() result(stat) type(observ_type) :: observ1, observ2 stat = TEST_PASSED - if (skip_test()) return + if (dm_test_skip('DM_MQUEUE_SKIP')) return stat = TEST_FAILED print *, 'Creating message queue "' // MQ_NAME // '" ...' @@ -76,7 +60,7 @@ logical function test01() result(stat) if (dm_is_error(rc)) return print *, 'Reading message queue attributes ...' - rc = dm_mqueue_attr(mqueue, flags, max_msg, msg_size, cur_msgs) + rc = dm_mqueue_attributes(mqueue, flags, max_msg, msg_size, cur_msgs) call dm_error_out(rc, dm_system_error_message()) if (dm_is_error(rc)) return @@ -127,7 +111,7 @@ logical function test02() result(stat) type(observ_type) :: observ1, observ2 stat = TEST_PASSED - if (skip_test()) return + if (dm_test_skip('DM_MQUEUE_SKIP')) return stat = TEST_FAILED rc = dm_mqueue_open(mqueue1, TYPE_OBSERV, MQ_NAME, MQUEUE_WRONLY) diff --git a/test/dmtestpipe.f90 b/test/dmtestpipe.f90 index b2a4cfe..5502682 100644 --- a/test/dmtestpipe.f90 +++ b/test/dmtestpipe.f90 @@ -20,31 +20,13 @@ program dmtestpipe implicit none (type, external) integer, parameter :: NTESTS = 1 - logical :: no_color logical :: stats(NTESTS) type(test_type) :: tests(NTESTS) call dm_init() - no_color = dm_env_has('NO_COLOR') - tests(1) = test_type('dmtestpipe.test01', test01) - - call dm_test_run(tests, stats, no_color) + call dm_test_run(tests, stats, dm_env_has('NO_COLOR')) contains - logical function skip_test() result(skip) - integer :: rc - - rc = dm_env_get('DM_PIPE_SKIP', skip) - - if (skip) then - call dm_ansi_color(COLOR_YELLOW, no_color) - print '("dmtestpipe:")' - print '(" Environment variable DM_PIPE_SKIP is set.")' - print '(" This test will be skipped.")' - call dm_ansi_reset(no_color) - end if - end function skip_test - logical function test01() result(stat) character(len=*), parameter :: COMMAND = 'cat -n' @@ -54,7 +36,7 @@ logical function test01() result(stat) type(pipe_type) :: stdin, stdout, stderr stat = TEST_PASSED - if (skip_test()) return + if (dm_test_skip('DM_PIPE_SKIP')) return stat = TEST_FAILED rc = dm_pipe_open2(stdin, stdout, stderr, COMMAND) diff --git a/test/dmtestplot.f90 b/test/dmtestplot.f90 index 25c4981..8da0f95 100644 --- a/test/dmtestplot.f90 +++ b/test/dmtestplot.f90 @@ -19,31 +19,13 @@ program dmtestplot implicit none (type, external) integer, parameter :: NTESTS = 1 - logical :: no_color logical :: stats(NTESTS) type(test_type) :: tests(NTESTS) call dm_init() - no_color = dm_env_has('NO_COLOR') - tests = [ test_type('dmtestplot.test01', test01) ] - - call dm_test_run(tests, stats, no_color) + call dm_test_run(tests, stats, dm_env_has('NO_COLOR')) contains - logical function skip_test() result(skip) - integer :: rc - - rc = dm_env_get('DM_PIPE_SKIP', skip) - - if (skip) then - call dm_ansi_color(COLOR_YELLOW, no_color) - print '("dmtestplot:")' - print '(" Environment variable DM_PIPE_SKIP is set.")' - print '(" This test will be skipped.")' - call dm_ansi_reset(no_color) - end if - end function skip_test - logical function test01() result(stat) character(len=:), allocatable :: bytes integer :: rc @@ -52,7 +34,7 @@ logical function test01() result(stat) type(dp_type) :: dps(3) stat = TEST_PASSED - if (skip_test()) return + if (dm_test_skip('DM_PIPE_SKIP')) return stat = TEST_FAILED plot%term = PLOT_TERM_SVG @@ -69,7 +51,7 @@ logical function test01() result(stat) print *, 'Writing to stdin ...' rc = dm_plot_lines(plot, dps) - call dm_perror(rc) + call dm_error_out(rc) if (dm_is_error(rc)) return print *, 'Reading from stdout ...' diff --git a/test/dmtestrpc.f90 b/test/dmtestrpc.f90 index 51bf585..dc5c142 100644 --- a/test/dmtestrpc.f90 +++ b/test/dmtestrpc.f90 @@ -45,9 +45,8 @@ logical function get_env(host, username, password) result(has) dm_is_error(dm_env_get('DM_API_PASSWORD', password))) then call dm_ansi_color(COLOR_YELLOW, no_color) - print '("dmtestrpc:")' - print '(" Set environment vars DM_RPC_HOST, DM_RPC_USERNAME, DM_API_PASSWORD")' - print '(" of the DMPACK RPC API. This test will be skipped.")' + print '("> Set environment vars DM_RPC_HOST, DM_RPC_USERNAME, DM_API_PASSWORD")' + print '("> of the DMPACK RPC API. This test will be skipped.")' call dm_ansi_reset(no_color) return end if