diff --git a/src/fortuno/argumentparser.f90 b/src/fortuno/argumentparser.f90 index 7adbfac..1f76ed9 100644 --- a/src/fortuno/argumentparser.f90 +++ b/src/fortuno/argumentparser.f90 @@ -4,6 +4,7 @@ !> Implements a simple command line argument parser module fortuno_argumentparser + use fortuno_basetypes, only : error_info use fortuno_env, only : nl use fortuno_testlogger, only : test_logger use fortuno_utils, only : basename, string_item, string_item_list @@ -12,13 +13,15 @@ module fortuno_argumentparser private public :: argtypes, argument_def, argument_values, argument_parser, init_argument_parser + ! Helper type for argument types type :: argument_types_enum_ integer :: bool = 1 - integer :: int = 2 - integer :: float = 3 - integer :: string = 4 integer :: stringlist = 5 + !! Following types are not implemented yet + ! integer :: int = 2 + ! integer :: float = 3 + ! integer :: string = 4 end type argument_types_enum_ !> Possible argument types @@ -135,12 +138,16 @@ subroutine argument_parser_parse_args(this, argumentvalues, logger, exitcode) exitcode = -1 call get_command_line_args_(cmdargs) + ! cmdargs starts with index 0 (entry 0 containing the command) nargs = ubound(cmdargs, dim=1) nargdefs = size(this%argdefs) allocate(processed(nargdefs), source=.false.) + ! Initial allocation, will be grown dynamically during argument processing allocate(argumentvalues%argvals(0)) allocate(posargs(0)) + + ! Parsing dashed arguments as options enabled; will be disabled if "--" is encountered optionsallowed = .true. ! Process all arguments @@ -153,20 +160,20 @@ subroutine argument_parser_parse_args(this, argumentvalues, logger, exitcode) cycle end if if (.not. optionsallowed .or. arg(1:1) /= "-") then - posargs = [posargs, string_item(arg)] + posargs = [posargs, string_item(arg)] cycle end if - islong = arg(1:min(len(arg), 2)) == "--" + islong = arg(1 : min(len(arg), 2)) == "--" if (islong) then argname = arg(3:) else if (len(arg) == 2) then argname = arg(2:2) else - call logger%log_error("Invalid short option '" // cmdargs(iarg)%value // "'") + call logger%log_error("Invalid short option '" // arg // "'") exitcode = 1 return end if - if ((islong .and. argname == "help") .or. (.not. islong .and. argname == "h")) then + if ((islong .and. argname == "help") .or. (.not. islong .and. argname == "h")) then call print_help_(logger, cmdargs(0)%value, this%description, this%argdefs) exitcode = 0 return @@ -215,7 +222,8 @@ subroutine argument_parser_parse_args(this, argumentvalues, logger, exitcode) ! Check collected positional arguments associate (argdef => this%argdefs(nargdefs)) - ! If the last argdef was not an option, store all position arguments under this name + + ! If last argdef was not an option, it defines name for all collected positional arguments if (.not. allocated(argdef%longopt) .and. argdef%shortopt == "") then ! Workaround:gfortran:14.1 (bug 116679) ! Omit array expression to avoid memory leak @@ -234,11 +242,13 @@ subroutine argument_parser_parse_args(this, argumentvalues, logger, exitcode) end block ! +} + ! If last argdef was an option, no positional arguments are allowed else if (size(posargs) > 1) then call logger%log_error("Superfluous positional arguments found") exitcode = 1 return end if + end associate end subroutine argument_parser_parse_args @@ -268,7 +278,7 @@ end function argument_values_has !> Returns the value of a parsed argument as array of strings - subroutine argument_values_get_value_stringlist(this, name, val) + subroutine argument_values_get_value_stringlist(this, name, val, error) !> Instance class(argument_values), intent(in) :: this @@ -276,9 +286,16 @@ subroutine argument_values_get_value_stringlist(this, name, val) !> Name of the argument character(*), intent(in) :: name - !> Value on exit + !> Value on exit, might be unallocated in case of an error type(string_item), allocatable, intent(out) :: val(:) + !> Error in case of an error occured, unallocated otherwise + !! + !! 1: invalid argument type + !! 2: argument with given name not found + !! + type(error_info), allocatable, intent(out) :: error + logical :: found integer :: iargval @@ -292,10 +309,12 @@ subroutine argument_values_get_value_stringlist(this, name, val) type is (string_item_list) val = argval%items class default - error stop "Invalid argument type for argument '" // name // "'" + error = error_info(1, "Invalid argument type for argument '" // name // "'") + return end select else - error stop "Argument '" // name // "' not found" + error = error_info(2, "Argument '" // name // "' not found") + return end if end subroutine argument_values_get_value_stringlist @@ -315,7 +334,10 @@ function new_argument_value(name, argval) result(this) end function new_argument_value - !! Returns the command line arguments as an array of strings. + !! Returns the command line arguments returned by get_command_argument as an array of strings. + !! + !! Note: returned array is indexed from zero (in analogy to get_command_argument()) + !! subroutine get_command_line_args_(cmdargs) type(string_item), allocatable :: cmdargs(:) @@ -356,7 +378,7 @@ subroutine print_help_(logger, scriptname, description, argdefs) call logger%log_message(line // nl // nl) call logger%log_message(description) associate (argdef => argdefs(size(argdefs))) - ! If last argument is a positional argument + ! If last argument is a positional argument, print its help (before optional arguments) if (argdef%shortopt == "" .and. .not. allocated(argdef%longopt)) then call print_argument_help_(logger, argdef%name, argdef%helpmsg, terminal_width_) end if @@ -375,15 +397,14 @@ subroutine print_help_(logger, scriptname, description, argdefs) else cycle end if - line = " " // buffer // repeat(" ", max(0, 24 - len(buffer) - 2)) // argdef%helpmsg - call logger%log_message(line) + call print_argument_help_(logger, buffer, argdef%helpmsg, terminal_width_) end associate end do end subroutine print_help_ - !! Prints the help for a single argument. + !! Prints help message for a single argument. subroutine print_argument_help_(logger, argument, helpmsg, linelength) class(test_logger), intent(inout) :: logger character(*), intent(in) :: argument, helpmsg @@ -396,6 +417,7 @@ subroutine print_argument_help_(logger, argument, helpmsg, linelength) write(formatstr, "(a, i0, a)") "(2x, a, t", offset, ", a)" maxwidth = linelength - offset + ! Position within the help message curpos = 1 do while (curpos <= len(helpmsg)) if (curpos + maxwidth - 1 > len(helpmsg)) then diff --git a/src/fortuno/basetypes.f90 b/src/fortuno/basetypes.f90 index e05edd2..f6bef86 100644 --- a/src/fortuno/basetypes.f90 +++ b/src/fortuno/basetypes.f90 @@ -10,6 +10,7 @@ module fortuno_basetypes public :: test_base, test_case_base, test_suite_base public :: test_item, test_ptr_item public :: test_list + public :: error_info !> Base class for all test objects @@ -83,8 +84,21 @@ module fortuno_basetypes end type test_suite_base + + !> Contains info about an internal error + type :: error_info + + !> Error code + integer :: code + + !> Error message + character(:), allocatable :: msg + + end type error_info + contains + !> Initializes a test item with the copy of a test_base instance. !! !! Note: This should be done only once for a test item instance. If the instance has already a diff --git a/src/fortuno/cmdapp.f90 b/src/fortuno/cmdapp.f90 index cc4f3e9..7aef70d 100644 --- a/src/fortuno/cmdapp.f90 +++ b/src/fortuno/cmdapp.f90 @@ -6,7 +6,7 @@ module fortuno_cmdapp use fortuno_argumentparser, only : argtypes, argument_def, argument_values, argument_parser,& & init_argument_parser - use fortuno_basetypes, only : test_list + use fortuno_basetypes, only : error_info, test_list use fortuno_utils, only : string_item use fortuno_testdriver, only : test_driver, test_selection use fortuno_testlogger, only : test_logger @@ -88,11 +88,17 @@ subroutine cmd_app_register_tests(this, testitems, exitcode) type(test_selection), allocatable :: selections(:) type(string_item), allocatable :: selectors(:), testnames(:) + type(error_info), allocatable :: error integer :: itest exitcode = -1 if (this%argvals%has("tests")) then - call this%argvals%get_value("tests", selectors) + call this%argvals%get_value("tests", selectors, error) + if (allocated(error)) then + call this%logger%log_error("internal error " // error%msg) + exitcode = error%code + return + end if call get_selections(selectors, selections) end if call this%driver%register_tests(testitems, selections=selections) diff --git a/src/fortuno_coarray.f90 b/src/fortuno_coarray.f90 index e7f772e..5b7e82b 100644 --- a/src/fortuno_coarray.f90 +++ b/src/fortuno_coarray.f90 @@ -2,12 +2,12 @@ ! Licensed under the BSD-2-Clause Plus Patent license. ! SPDX-License-Identifier: BSD-2-Clause-Patent -!> Exports the coarray-dependent part of Fortuno +!> Interface module for the Fortuno testing framework with the coarray interface. module fortuno_coarray use fortuno + use fortuno_coarray_coabasetypes, only : coa_pure_case_base, coa_pure_suite_base use fortuno_coarray_coacmdapp, only : coa_cmd_app, execute_coa_cmd_app, init_coa_cmd_app - use fortuno_coarray_coacontext, only : as_coa_context, coa_context, coa_context_factory,& - & init_coa_context_factory + use fortuno_coarray_coacontext, only : coa_context use fortuno_coarray_coapurecase, only : coa_pure_case, coa_pure_case_item use fortuno_coarray_coapuresuite, only : coa_pure_suite, coa_pure_suite_item implicit none diff --git a/src/fortuno_mpi.f90 b/src/fortuno_mpi.f90 index 907cd1f..22a8fd4 100644 --- a/src/fortuno_mpi.f90 +++ b/src/fortuno_mpi.f90 @@ -2,15 +2,16 @@ ! Licensed under the BSD-2-Clause Plus Patent license. ! SPDX-License-Identifier: BSD-2-Clause-Patent -!> Exports the MPI-dependent part of Fortuno +!> Interface module for the Fortuno testing framework with the MPI interface. module fortuno_mpi use fortuno use fortuno_mpi_mpibasetypes, only : mpi_case_base, mpi_suite_base - use fortuno_mpi_mpicmdapp, only : mpi_cmd_app, execute_mpi_cmd_app + use fortuno_mpi_mpicmdapp, only : execute_mpi_cmd_app, init_mpi_cmd_app, mpi_cmd_app use fortuno_mpi_mpicontext, only : mpi_context use fortuno_mpi_mpiglobalctx, only : global_comm, global_comm_id, mpi_check, mpi_check_failed,& - & mpi_failed, mpi_skip, mpi_skipped, mpi_scope_pointers, num_ranks, this_rank + & mpi_failed, mpi_scope_pointers, mpi_skip, mpi_skipped, num_ranks, this_rank use fortuno_mpi_mpicase, only : mpi_case, mpi_case_item use fortuno_mpi_mpisuite, only : mpi_suite, mpi_suite_item implicit none -end module + +end module fortuno_mpi diff --git a/src/fortuno_serial.f90 b/src/fortuno_serial.f90 index de5470e..67c543b 100644 --- a/src/fortuno_serial.f90 +++ b/src/fortuno_serial.f90 @@ -8,6 +8,7 @@ module fortuno_serial use fortuno_serial_serialbasetypes, only : serial_case_base, serial_suite_base use fortuno_serial_serialcmdapp, only : execute_serial_cmd_app, init_serial_cmd_app,& & serial_cmd_app + use fortuno_serial_serialcontext, only : serial_context use fortuno_serial_serialglobalctx, only : serial_check, serial_check_failed, serial_failed,& & serial_scope_pointers, serial_skip, serial_skipped, serial_store_state use fortuno_serial_serialcase, only : serial_case, serial_case_item